1 Option Explicit
   2 Option Private Module
   3 
   4 ' //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
   5 ''' // Array handling functions
   6 ''' // (c)digital-ecom GmbH, 2009
   7 
   8 ''' // The following functions were developed and used over the years for various projects. The functions alow:
   9 ''' // - retrieving arrays consisting of unique values
  10 ''' // - sorting arrays
  11 ''' // - finding values in arrays
  12 ''' // - etc.
  13 ''' // Most of the functions are available for usage with multi dimensional arrays, too.
  14 
  15 ''' // Multidimensional Arrays
  16 ''' // Arrays should be build by Rows, means having a fixed set of Rows and a flexible set of columns.
  17 ''' // Ex.: tmpArray(2,n)
  18 ''' //        tmpArray(1,n) = ProductID
  19 ''' //        tmpArray(2,n) = Productname
  20 ''' //        tmpArray(3,n) = Turnover
  21 ''' //        with n as counter for all your customers.
  22 ''' // When talking about multidimensional arrays we talk about this type of array.
  23 
  24 ''' // Finding in Arrays is done by Binary or Sequential Search; for both a strongly typed version is available.
  25 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  26 
  27 
  28 ''' // *********************************************************************************
  29 ''' // Arrays: Unique Values
  30 ''' // *********************************************************************************
  31 
  32 ' //////////////////////////////////////////////////////////////
  33 ''' // Create an array consisting of unique values, only.
  34 ''' // The fct. expects a unidimensional array.
  35 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  36 Function Array_Unique(ByRef InputArray As Variant) As Variant
  37 ReDim TMP_Array(0)
  38 Dim i As Long
  39 Dim j As Long
  40 Dim c As Long
  41 Dim Found As Boolean
  42 
  43     c = 0
  44     For i = 0 To UBound(InputArray)
  45         For j = 0 To UBound(TMP_Array)
  46             If InputArray(i) = "" Or InputArray(i) = TMP_Array(j) And Not isEmpty(TMP_Array(j)) Then
  47                 Found = True
  48                 Exit For
  49             Else
  50                 Found = False
  51             End If
  52         Next
  53         If Found = True Then
  54         Else
  55             ReDim Preserve TMP_Array(c)
  56             TMP_Array(c) = InputArray(i)
  57             c = c + 1
  58         End If
  59     Next
  60 
  61     Array_Unique = TMP_Array
  62 End Function
  63 
  64 ' //////////////////////////////////////////////////////////////
  65 ''' // Create an array consisting of unique values, only.
  66 ''' // The fct. expects a multidimensional array.
  67 ''' // LookupRow = the row where the data to find is in
  68 ''' // Dimension = the dimension of the array (equals ubound(Text_Array,1))
  69 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  70 Function MDArray_Unique(ByRef InputArray As Variant, ByRef LookupRow As Integer, ByRef Dimension As Integer) As Variant
  71 ReDim TMP_Array(Dimension, 0)
  72 Dim i As Long, j As Long, c As Long
  73 Dim Found As Boolean
  74 Dim k As Integer
  75 
  76     c = 0
  77     For i = 0 To UBound(InputArray, 2)
  78         For j = 0 To UBound(TMP_Array, 2)
  79             If InputArray(LookupRow, i) = "" Or InputArray(LookupRow, i) = TMP_Array(LookupRow, j) Then
  80                 Found = True
  81                 Exit For
  82             Else
  83                 Found = False
  84             End If
  85         Next
  86 
  87         If Found = True Then
  88         Else
  89             ReDim Preserve TMP_Array(Dimension, c)
  90             For k = 0 To Dimension
  91                 TMP_Array(k, c) = InputArray(k, i)
  92             Next
  93             c = c + 1
  94         End If
  95     Next
  96 
  97     MDArray_Unique = TMP_Array
  98 End Function
  99 
 100 ''' // *********************************************************************************
 101 ''' // Arrays: Add, Delete and Move; Check if empty; create an array of 1 single value
 102 ''' // *********************************************************************************
 103 
 104 ' //////////////////////////////////////////////////////////////
 105 ''' // ADD VALUE TO ARRAY
 106 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 107 ''' //
 108 ''' // Purpose: Add value to array at given position; if to add at end of array, submit UBound of array plus 1.
 109 ''' // This only works with single dim Arrays.
 110 Function Array_Add_String(ByRef InputArray As Variant, ByRef Position As Long, ByRef Value2Add As Variant) As Variant
 111 Dim Upperbound As Long
 112 Dim i As Long
 113 
 114     Upperbound = UBound(InputArray)
 115     ReDim TMP_Array(Upperbound + 1)
 116 
 117     For i = 0 To Position - 1
 118         TMP_Array(i) = InputArray(i)
 119     Next
 120 
 121     TMP_Array(i) = Value2Add
 122 
 123     For i = Position To Upperbound
 124         TMP_Array(i + 1) = InputArray(i)
 125     Next
 126 
 127     Array_Add_String = TMP_Array
 128 End Function
 129 
 130 ' //////////////////////////////////////////////////////////////
 131 ''' // ADD ARRAY TO MULTIDIMENSIONAL ARRAY
 132 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 133 ''' // Purpose: Add array, since we are feeding a multidimensional array,  to array at given position; if to add at end of array, submit UBound of array plus 1 as Position.
 134 Function MDArray_Add_Array(ByRef InputArray As Variant, ByRef Position As Long, ByRef Array2Add As Variant) As Variant
 135 Dim Upperbound1 As Long
 136 Dim Upperbound2 As Long
 137 Dim i As Long
 138 Dim j As Long
 139 
 140     Upperbound1 = UBound(InputArray, 1)
 141     Upperbound2 = UBound(InputArray, 2)
 142 
 143     ReDim TMP_Array(Upperbound1, Upperbound2 + 1)
 144 
 145     For i = 0 To Position - 1
 146         For j = 0 To Upperbound1
 147             TMP_Array(j, i) = InputArray(j, i)
 148         Next
 149     Next
 150 
 151     For j = 0 To Upperbound1
 152         TMP_Array(j, i) = Array2Add(j)
 153     Next
 154 
 155     For i = Position To Upperbound2
 156         For j = 0 To Upperbound1
 157             TMP_Array(j, i + 1) = InputArray(j, i)
 158         Next
 159     Next
 160 
 161     MDArray_Add_Array = TMP_Array
 162 End Function
 163 
 164 
 165 ' //////////////////////////////////////////////////////////////
 166 ''' // DELETE FROM ARRAY
 167 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 168 ''' // Function: Delete entry from a given array at given position
 169 ''' // Input: Array to delete from; position (index number) of entry to delete.
 170 ''' // This only works with single dim Arrays but could easily be adopted for multi dimensional arrays.
 171 Function Array_Delete(ByRef InputArray As Variant, ByRef Position As Long)
 172 Dim Upperbound As Long
 173 Dim i As Long
 174 
 175     Upperbound = UBound(InputArray)
 176 
 177     If Upperbound = 0 Then
 178         ReDim TMP_Array(0)
 179     Else
 180         ReDim TMP_Array(Upperbound - 1)
 181     End If
 182 
 183     For i = 0 To Position - 1
 184         TMP_Array(i) = InputArray(i)
 185     Next
 186 
 187     For i = Position + 1 To Upperbound
 188         TMP_Array(i - 1) = InputArray(i)
 189     Next
 190 
 191     Array_Delete = TMP_Array
 192 End Function
 193 
 194 
 195 ' //////////////////////////////////////////////////////////////
 196 ''' // MOVE UP IN ARRAY
 197 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 198 ''' // Function: Move Up the given entry within array.
 199 ''' // Input: Array to work with; position (index number) of entry to move up.
 200 ''' // Note: You can easily obtain the listindex (position) of the currently selected entry within a ListBox
 201 ''' //           and easily move it up one row by use of this fct.
 202 ''' // This only works with single dim Arrays.
 203 Function Array_MoveUP(ByRef InputArray As Variant, ByRef Position As Integer)
 204 Dim Upperbound As Long
 205 Dim i As Long
 206 
 207     Upperbound = UBound(InputArray)
 208     ReDim TMP_Array(Upperbound)
 209 
 210     For i = 0 To Position - 2
 211         TMP_Array(i) = InputArray(i)
 212     Next
 213 
 214     TMP_Array(i) = InputArray(Position)
 215     TMP_Array(i + 1) = InputArray(Position - 1)
 216 
 217     For i = Position + 1 To Upperbound
 218         TMP_Array(i) = InputArray(i)
 219     Next
 220 
 221     Array_MoveUP = TMP_Array
 222 End Function
 223 
 224 ' //////////////////////////////////////////////////////////////
 225 ''' // MOVE DOWN IN ARRAY
 226 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 227 ''' // Function: Move DOWN the given entry within array.
 228 ''' // Input: Array to work with; position (index number) of entry to move down.
 229 ''' // Note: You can easily obtain the listindex (position) of the currently selected entry within a ListBox
 230 ''' //           and easily move it down one row by use of this fct.
 231 ''' // This only works with single dim Arrays.
 232 Function Array_MoveDOWN(InputArray As Variant, Position As Integer)
 233 Dim Upperbound As Long
 234 Dim i As Long
 235 
 236     Upperbound = UBound(InputArray)
 237     ReDim TMP_Array(Upperbound)
 238 
 239     For i = 0 To Position - 1
 240         TMP_Array(i) = InputArray(i)
 241     Next
 242 
 243     TMP_Array(i + 1) = InputArray(Position)
 244     TMP_Array(i) = InputArray(Position + 1)
 245 
 246     For i = Position + 2 To Upperbound
 247         TMP_Array(i) = InputArray(i)
 248     Next
 249 
 250     Array_MoveDOWN = TMP_Array
 251 End Function
 252 
 253 ' //////////////////////////////////////////////////////////////
 254 ''' // EMPTY ARRAY - STRING
 255 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 256 ''' // Check if a multi dimensional array has empty values.
 257 ''' // Input: Array to check (consisting of string values), Number of Rows (Dimension).
 258 ''' // Ex.: tmpArray(2,i) with Dimension = 2.
 259 Function ArrayisEmpty_ByRows(ByRef InputArray As Variant, ByRef iRows As Integer) As Boolean
 260 Dim i As Long, j As Integer
 261 Dim isEmpty As Boolean
 262 
 263     For i = 0 To UBound(InputArray, 2)
 264         For j = 0 To iRows
 265             If InputArray(j, i) = "" Then
 266                 isEmpty = True
 267             Else
 268                 isEmpty = False
 269                 Exit For
 270             End If
 271         Next
 272         If isEmpty = False Then Exit For
 273     Next
 274     ArrayisEmpty_ByRows = isEmpty
 275 End Function
 276 
 277 ' //////////////////////////////////////////////////////////////
 278 ''' // CREATE ARRAY OF ONE VALUE
 279 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 280 ''' // Create an array containing just one value; this is useful in case we normally compare values against an array but some of the data is available as single data only.
 281 ''' // Putting those single values into an array allows looping over all arrays to use.
 282 ''' // Input: The value to add to the array.
 283 ''' // Returns: Array.
 284 Function ArrayCreate_SingleValue(ByRef sValue As Variant) As Variant
 285 Dim tmpArray(0)
 286     tmpArray(0) = sValue
 287     ArrayCreate_SingleValue = tmpArray
 288 End Function
 289 
 290 
 291 ''' // *********************************************************************************
 292 ''' // Arrays: Sort
 293 ''' // *********************************************************************************
 294 
 295 ' //////////////////////////////////////////////////////////////
 296 ''' // SHELL SORT ARRAY (SINGLE DIMENSION) STRING
 297 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 298 ''' // Function: Sorts array by use of Shellsort
 299 ''' // Input: array,containing text values, to sort; Ascending Sort Order as boolean.
 300 ''' // Returns: Single dimensioned + sorted array.
 301 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 302 Function ShellSortSingle_Dimension(ByRef InputArray As Variant, ByRef isSortAscending As Boolean) As Variant
 303    Dim i As Long
 304    Dim j As Long
 305    Dim iLBound As Long
 306    Dim iUBound As Long
 307    Dim iMax As Long
 308    Dim iTemp As String
 309    Dim distance As Long
 310    Dim bSortOrder As Boolean
 311 
 312    iLBound = LBound(InputArray)
 313    iUBound = UBound(InputArray)
 314 
 315     If isSortAscending = True Then
 316         bSortOrder = False
 317     Else
 318         bSortOrder = True
 319     End If
 320 
 321    iMax = iUBound - iLBound + 1
 322 
 323    Do
 324         distance = distance * 3 + 1
 325    Loop Until distance > iMax
 326 
 327    Do
 328       distance = distance \ 3
 329       For i = distance + iLBound To iUBound
 330          iTemp = CStr(InputArray(i))
 331          j = i
 332          Do While CStr(InputArray(j - distance)) > iTemp Xor bSortOrder
 333             InputArray(j) = InputArray(j - distance)
 334             j = j - distance
 335             If j - distance < iLBound Then Exit Do
 336          Loop
 337          InputArray(j) = iTemp
 338       Next i
 339    Loop Until distance = 1
 340 
 341    'ShellSortSingle_Dimension = InputArray
 342 End Function
 343 
 344 ' //////////////////////////////////////////////////////////////
 345 ''' // SHELL SORT ARRAY (SINGLE DIMENSION) LONG
 346 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 347 ''' // Function: Sorts array by use of Shellsort (converts array values to long when comparing values)
 348 ''' // Input: array, containing long values, to sort; SortOrder as boolean (specify True to sort ascending)
 349 ''' // Returns: Single dimensioned + sorted array.
 350 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 351 Function ShellSortSingle_Dimension_Long(ByRef InputArray As Variant, ByRef isSortAscending As Boolean) As Variant
 352    Dim i As Long
 353    Dim j As Long
 354    Dim iLBound As Long
 355    Dim iUBound As Long
 356    Dim iMax As Long
 357    Dim iTemp As Long
 358    Dim distance As Long
 359    Dim bSortOrder As Boolean
 360 
 361    iLBound = LBound(InputArray)
 362    iUBound = UBound(InputArray)
 363 
 364     If isSortAscending = True Then
 365         bSortOrder = False
 366     Else
 367         bSortOrder = True
 368     End If
 369 
 370    iMax = iUBound - iLBound + 1
 371 
 372    Do
 373       distance = distance * 3 + 1
 374    Loop Until distance > iMax
 375 
 376    Do
 377       distance = distance \ 3
 378       For i = distance + iLBound To iUBound
 379          iTemp = CLng(InputArray(i))
 380          j = i
 381          Do While CLng(InputArray(j - distance)) > iTemp Xor bSortOrder
 382             InputArray(j) = CLng(InputArray(j - distance))
 383             j = j - distance
 384             If j - distance < iLBound Then Exit Do
 385          Loop
 386          InputArray(j) = iTemp
 387       Next i
 388    Loop Until distance = 1
 389 
 390    'ShellSortSingle_Dimension_Long = InputArray
 391 End Function
 392 
 393 ' //////////////////////////////////////////////////////////////
 394 ''' // SHELL SORT ARRAY (SINGLE DIMENSION) DOUBLE
 395 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 396 ''' // Function: Sorts array by use of Shellsort (converts array values to long when comparing values)
 397 ''' // Input: array, containing  double values, to sort; SortOrder as boolean (specify True to sort ascending)
 398 ''' // Returns: Single dimensioned + sorted array.
 399 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 400 Function ShellSortSingle_Dimension_Double(ByRef InputArray As Variant, ByRef isSortAscending As Boolean) As Variant
 401    Dim i As Long
 402    Dim j As Long
 403    Dim iLBound As Long
 404    Dim iUBound As Long
 405    Dim iMax As Long
 406    Dim iTemp As Double
 407    Dim distance As Long
 408    Dim bSortOrder As Boolean
 409 
 410    iLBound = LBound(InputArray)
 411    iUBound = UBound(InputArray)
 412 
 413     If isSortAscending = True Then
 414         bSortOrder = False
 415     Else
 416         bSortOrder = True
 417     End If
 418 
 419    iMax = iUBound - iLBound + 1
 420 
 421    Do
 422       distance = distance * 3 + 1
 423    Loop Until distance > iMax
 424 
 425    Do
 426       distance = distance \ 3
 427       For i = distance + iLBound To iUBound
 428          iTemp = CDbl(InputArray(i))
 429          j = i
 430          Do While CDbl(InputArray(j - distance)) > iTemp Xor bSortOrder
 431             InputArray(j) = CDbl(InputArray(j - distance))
 432             j = j - distance
 433             If j - distance < iLBound Then Exit Do
 434          Loop
 435          InputArray(j) = iTemp
 436       Next i
 437    Loop Until distance = 1
 438 
 439    'ShellSortSingle_Dimension_Double = InputArray
 440 End Function
 441 
 442 ' //////////////////////////////////////////////////////////////
 443 ''' // SHELL SORT ARRAY (ANY DIMENSION) STRING
 444 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 445 ''' // Function: Sorts multi dimensioned array by use of Shellsort
 446 ''' // Ex.: tmpArray(2,i) with i being any number.
 447 ''' // Input: Array to sort, the row number to sort, the number of all rows (Dimension), whether to sort ascending or not.
 448 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 449 Function ShellSortAny_Dimension_ByRows(ByRef InputArray As Variant, ByRef LookupRow As Integer, ByRef Dimension As Integer, ByRef isSortAscending As Boolean) As Variant
 450 Dim i  As Long
 451 Dim j  As Long
 452 Dim c As Long
 453 Dim k As Long
 454 Dim iLBound As Long
 455 Dim iUBound As Long
 456 Dim iMax As Long
 457 Dim vTemp As Variant
 458 Dim distance As Long
 459 Dim bSortOrder As Boolean
 460 ReDim TMP_Array(Dimension)
 461 
 462     If Not IsArray(InputArray) Then Exit Function
 463 
 464     iLBound = LBound(InputArray, 2)
 465     iUBound = UBound(InputArray, 2)
 466 
 467     If isSortAscending = True Then
 468          bSortOrder = False
 469     Else
 470          bSortOrder = True
 471     End If
 472     iMax = iUBound - iLBound + 1
 473 
 474     Do
 475         distance = distance * 3 + 1
 476     Loop Until distance > iMax
 477 
 478     Do
 479         distance = distance \ 3
 480         For i = distance + iLBound To iUBound
 481 
 482                For k = 0 To Dimension
 483                     If k = LookupRow Then
 484                         TMP_Array(k) = CStr(InputArray(k, i))
 485                     Else
 486                         TMP_Array(k) = InputArray(k, i)
 487                     End If
 488                Next
 489                j = i
 490 
 491                Do While (CStr(InputArray(LookupRow, j - distance)) > TMP_Array(LookupRow)) Xor bSortOrder
 492                   For k = 0 To Dimension
 493                         InputArray(k, j) = InputArray(k, j - distance)
 494                   Next
 495                   j = j - distance
 496                   If j - distance < iLBound Then Exit Do
 497                Loop
 498 
 499                For k = 0 To Dimension
 500                    InputArray(k, j) = TMP_Array(k)
 501                Next
 502 
 503         Next i
 504     Loop Until distance = 1
 505 
 506     'ShellSortAny_Dimension_ByRows = InputArray
 507 End Function
 508 
 509 ' //////////////////////////////////////////////////////////////
 510 ''' // SHELL SORT ARRAY (ANY DIMENSION) LONG
 511 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 512 ''' // Function: Sorts multi dimensioned array by use of Shellsort
 513 ''' // Ex.: tmpArray(2,i) with i being any number.
 514 ''' // Input: Array to sort, the row number to sort, the number of all rows (Dimension), whether to sort ascending or not.
 515 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 516 Function ShellSortAny_Dimension_ByRows_Long(ByRef InputArray As Variant, ByRef LookupRow As Integer, ByRef Dimension As Integer, ByRef isSortAscending As Boolean) As Variant
 517 Dim i  As Long
 518 Dim j  As Long
 519 Dim c As Long
 520 Dim k As Long
 521 Dim iLBound As Long
 522 Dim iUBound As Long
 523 Dim iMax As Long
 524 Dim vTemp As Variant
 525 Dim distance As Long
 526 Dim bSortOrder As Boolean
 527 ReDim TMP_Array(Dimension)
 528 
 529     If Not IsArray(InputArray) Then Exit Function
 530 
 531     iLBound = LBound(InputArray, 2)
 532     iUBound = UBound(InputArray, 2)
 533 
 534     If isSortAscending = True Then
 535          bSortOrder = False
 536     Else
 537          bSortOrder = True
 538     End If
 539     iMax = iUBound - iLBound + 1
 540 
 541     Do
 542         distance = distance * 3 + 1
 543     Loop Until distance > iMax
 544 
 545     Do
 546         distance = distance \ 3
 547         For i = distance + iLBound To iUBound
 548 
 549                For k = 0 To Dimension
 550                     If k = LookupRow Then
 551                         TMP_Array(k) = CLng(InputArray(k, i))
 552                     Else
 553                         TMP_Array(k) = InputArray(k, i)
 554                     End If
 555                Next
 556                j = i
 557 
 558                Do While (CLng(InputArray(LookupRow, j - distance)) > TMP_Array(LookupRow)) Xor bSortOrder
 559                   For k = 0 To Dimension
 560                         InputArray(k, j) = InputArray(k, j - distance)
 561                   Next
 562                   j = j - distance
 563                   If j - distance < iLBound Then Exit Do
 564                Loop
 565 
 566                For k = 0 To Dimension
 567                    InputArray(k, j) = TMP_Array(k)
 568                Next
 569 
 570         Next i
 571     Loop Until distance = 1
 572 
 573     'ShellSortAny_Dimension_ByRows_Long = InputArray
 574 End Function
 575 
 576 ' //////////////////////////////////////////////////////////////
 577 ''' // SHELL SORT ARRAY (ANY DIMENSION) DOUBLE
 578 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 579 ''' // Function: Sorts multi dimensioned array by use of Shellsort
 580 ''' // Ex.: tmpArray(2,i) with i being any number.
 581 ''' // Input: Array to sort, the row number to sort, the number of all rows (Dimension), whether to sort ascending or not.
 582 ''' // Note: In order to keep the unsorted input array pass it to this fct. ByVal and uncomment the return command of the fct.
 583 Function ShellSortAny_Dimension_ByRows_Double(ByRef InputArray As Variant, ByRef LookupRow As Integer, ByRef Dimension As Integer, ByRef isSortAscending As Boolean) As Variant
 584 Dim i  As Long
 585 Dim j  As Long
 586 Dim c As Long
 587 Dim k As Long
 588 Dim iLBound As Long
 589 Dim iUBound As Long
 590 Dim iMax As Long
 591 Dim vTemp As Double
 592 Dim distance As Long
 593 Dim bSortOrder As Boolean
 594 ReDim TMP_Array(Dimension)
 595 
 596     If Not IsArray(InputArray) Then Exit Function
 597 
 598     iLBound = LBound(InputArray, 2)
 599     iUBound = UBound(InputArray, 2)
 600 
 601     If isSortAscending = True Then
 602          bSortOrder = False
 603     Else
 604          bSortOrder = True
 605     End If
 606     iMax = iUBound - iLBound + 1
 607 
 608     Do
 609         distance = distance * 3 + 1
 610     Loop Until distance > iMax
 611 
 612     Do
 613         distance = distance \ 3
 614         For i = distance + iLBound To iUBound
 615 
 616                For k = 0 To Dimension
 617                     If k = LookupRow Then
 618                         TMP_Array(k) = CDbl(InputArray(k, i))
 619                     Else
 620                         TMP_Array(k) = InputArray(k, i)
 621                     End If
 622                Next
 623                j = i
 624 
 625                Do While (CDbl(InputArray(LookupRow, j - distance)) > TMP_Array(LookupRow)) Xor bSortOrder
 626                   For k = 0 To Dimension
 627                         InputArray(k, j) = InputArray(k, j - distance)
 628                   Next
 629                   j = j - distance
 630                   If j - distance < iLBound Then Exit Do
 631                Loop
 632 
 633                For k = 0 To Dimension
 634                    InputArray(k, j) = TMP_Array(k)
 635                Next
 636 
 637         Next i
 638     Loop Until distance = 1
 639 
 640     'ShellSortAny_Dimension_ByRows_Double = InputArray
 641 End Function
 642 
 643 ''' // *********************************************************************************
 644 ''' // Arrays: Search
 645 ''' // *********************************************************************************
 646 
 647 ' //////////////////////////////////////////////////////////////
 648 ''' // BINARY SEARCH ARRAY - VARIANT
 649 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 650 ''' // Search within an Array of strings or numbers for occurance of a certain string/number.
 651 ''' // Binary Search can be used only, in case the value of each entry within SearchCol is unique !
 652 ''' // Binary Search can be used only, in case the array has been sorted previously !
 653 ''' // Input: Array to search in, Value to find, sType as string indicating whether to compare strings, longs or doubles.
 654 ''' // Returns: Index position of value found or -1 in case value was not found.
 655 Public Function BinarySearch(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef sType As String) As Long
 656 Dim iLBound As Long
 657 Dim iUBound As Long
 658 Dim iMiddle As Long
 659 Dim vFind As Variant
 660 
 661     If LCase(sType) = "string" Then
 662         vFind = CStr(sFind)
 663     ElseIf LCase(sType) = "double" Then
 664         vFind = CDbl(sFind)
 665     ElseIf LCase(sType) = "long" Then
 666         vFind = CLng(sFind)
 667     Else
 668         vFind = sFind
 669     End If
 670 
 671     iLBound = LBound(InputArray)
 672     iUBound = UBound(InputArray)
 673 
 674     Do
 675         iMiddle = (iLBound + iUBound) \ 2
 676         If InputArray(iMiddle) = vFind Then
 677             BinarySearch = iMiddle
 678             Exit Function
 679         ElseIf InputArray(iMiddle) < vFind Then
 680             iLBound = iMiddle + 1
 681         Else
 682             iUBound = iMiddle - 1
 683         End If
 684     Loop Until iLBound > iUBound
 685 
 686     BinarySearch = -1
 687 End Function
 688 
 689 ' //////////////////////////////////////////////////////////////
 690 ''' // BINARY SEARCH ARRAY (ANY DIMENSION) - VARIANT
 691 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 692 ''' // Search within amulti dimensional Array of strings or numbers for occurance of a certain string/number.
 693 ''' // Binary Search can be used only, in case the value of each entry within SearchCol is unique !
 694 ''' // Binary Search can be used only, in case the array has been sorted previously !
 695 ''' // Input: Array to search in, Value to find, row number to lookup search value in, sType as string indicating whether to compare strings, longs or doubles.
 696 ''' // Returns: Index position of value found or -1 in case value was not found.
 697 Public Function BinarySearch_ByRows(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef LookupRow As Integer, ByRef sType As String) As Long
 698 Dim iLBound As Long
 699 Dim iUBound As Long
 700 Dim iMiddle As Long
 701 Dim vFind As Variant
 702 
 703     If LCase(sType) = "string" Then
 704         vFind = CStr(sFind)
 705     ElseIf LCase(sType) = "double" Then
 706         vFind = CDbl(sFind)
 707     ElseIf LCase(sType) = "long" Then
 708         vFind = CLng(sFind)
 709     Else
 710         vFind = sFind
 711     End If
 712 
 713     iLBound = LBound(InputArray, 2)
 714     iUBound = UBound(InputArray, 2)
 715 
 716     Do
 717        iMiddle = (iLBound + iUBound) \ 2
 718 
 719        If InputArray(LookupRow, iMiddle) = vFind Then
 720           BinarySearch_ByRows = iMiddle
 721           Exit Function
 722        ElseIf InputArray(LookupRow, iMiddle) < vFind Then
 723           iLBound = iMiddle + 1
 724        Else
 725           iUBound = iMiddle - 1
 726        End If
 727     Loop Until iLBound > iUBound
 728 
 729     BinarySearch_ByRows = -1
 730 End Function
 731 
 732 ' //////////////////////////////////////////////////////////////
 733 ''' // BINARY SEARCH ARRAY STRONG TYPED - VARIANT
 734 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 735 ''' // Search within an Array of strings or numbers for occurance of a certain string/number.
 736 ''' // Binary Search can be used only, in case the value of each entry within SearchCol is unique !
 737 ''' // Binary Search can be used only, in case the array has been sorted previously !
 738 ''' // Input: Array to search in, Value to find, sType as string indicating whether to compare strings, longs or doubles.
 739 ''' // Returns: Index position of value found or -1 in case value was not found.
 740 ''' // Note: This fct. performs a comparison between strongly typed parameters.
 741 Public Function BinarySearch_ST(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef sType As String) As Long
 742 Dim iLBound As Long
 743 Dim iUBound As Long
 744 Dim iMiddle As Long
 745 Dim vFind As Variant
 746 
 747     If LCase(sType) = "string" Then
 748         vFind = CStr(sFind)
 749     ElseIf LCase(sType) = "double" Then
 750         vFind = CDbl(sFind)
 751     ElseIf LCase(sType) = "long" Then
 752         vFind = CLng(sFind)
 753     Else
 754         vFind = sFind
 755     End If
 756 
 757     iLBound = LBound(InputArray)
 758     iUBound = UBound(InputArray)
 759 
 760     Select Case LCase(sType)
 761         Case "string"
 762             Do
 763                 iMiddle = (iLBound + iUBound) \ 2
 764                 If CStr(InputArray(iMiddle)) = vFind Then
 765                     BinarySearch_ST = iMiddle
 766                     Exit Function
 767                 ElseIf CStr(InputArray(iMiddle)) < vFind Then
 768                     iLBound = iMiddle + 1
 769                 Else
 770                     iUBound = iMiddle - 1
 771                 End If
 772             Loop Until iLBound > iUBound
 773         Case "long"
 774             Do
 775                 iMiddle = (iLBound + iUBound) \ 2
 776                 If CLng(InputArray(iMiddle)) = vFind Then
 777                     BinarySearch_ST = iMiddle
 778                     Exit Function
 779                 ElseIf CLng(InputArray(iMiddle)) < vFind Then
 780                     iLBound = iMiddle + 1
 781                 Else
 782                     iUBound = iMiddle - 1
 783                 End If
 784             Loop Until iLBound > iUBound
 785         Case "double"
 786             Do
 787                 iMiddle = (iLBound + iUBound) \ 2
 788                 If CDbl(InputArray(iMiddle)) = vFind Then
 789                     BinarySearch_ST = iMiddle
 790                     Exit Function
 791                 ElseIf CDbl(InputArray(iMiddle)) < vFind Then
 792                     iLBound = iMiddle + 1
 793                 Else
 794                     iUBound = iMiddle - 1
 795                 End If
 796             Loop Until iLBound > iUBound
 797         Case Else
 798             Do
 799                 iMiddle = (iLBound + iUBound) \ 2
 800                 If InputArray(iMiddle) = vFind Then
 801                     BinarySearch_ST = iMiddle
 802                     Exit Function
 803                 ElseIf InputArray(iMiddle) < vFind Then
 804                     iLBound = iMiddle + 1
 805                 Else
 806                     iUBound = iMiddle - 1
 807                 End If
 808             Loop Until iLBound > iUBound
 809     End Select
 810 
 811     BinarySearch_ST = -1
 812 End Function
 813 
 814 ' //////////////////////////////////////////////////////////////
 815 ''' // BINARY SEARCH ARRAY (ANY DIMENSION) STRONG TYPED - VARIANT
 816 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 817 ''' // Search within amulti dimensional Array of strings or numbers for occurance of a certain string/number.
 818 ''' // Binary Search can be used only, in case the value of each entry within SearchCol is unique !
 819 ''' // Binary Search can be used only, in case the array has been sorted previously !
 820 ''' // Input: Array to search in, Value to find, row number to lookup search value in, sType as string indicating whether to compare strings, longs or doubles.
 821 ''' // Returns: Index position of value found or -1 in case value was not found.
 822 ''' // Note: This fct. performs a comparison between strongly typed parameters.
 823 Public Function BinarySearch_ByRows_ST(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef LookupRow As Integer, ByRef sType As String) As Long
 824 Dim iLBound As Long
 825 Dim iUBound As Long
 826 Dim iMiddle As Long
 827 Dim vFind As Variant
 828 
 829     If LCase(sType) = "string" Then
 830         vFind = CStr(sFind)
 831     ElseIf LCase(sType) = "double" Then
 832         vFind = CDbl(sFind)
 833     ElseIf LCase(sType) = "long" Then
 834         vFind = CLng(sFind)
 835     Else
 836         vFind = sFind
 837     End If
 838 
 839     iLBound = LBound(InputArray, 2)
 840     iUBound = UBound(InputArray, 2)
 841 
 842     Select Case LCase(sType)
 843         Case "string"
 844             Do
 845                iMiddle = (iLBound + iUBound) \ 2
 846 
 847                If CStr(InputArray(LookupRow, iMiddle)) = vFind Then
 848                   BinarySearch_ByRows_ST = iMiddle
 849                   Exit Function
 850                ElseIf CStr(InputArray(LookupRow, iMiddle)) < vFind Then
 851                   iLBound = iMiddle + 1
 852                Else
 853                   iUBound = iMiddle - 1
 854                End If
 855             Loop Until iLBound > iUBound
 856         Case "long"
 857             Do
 858                iMiddle = (iLBound + iUBound) \ 2
 859 
 860                If CLng(InputArray(LookupRow, iMiddle)) = vFind Then
 861                   BinarySearch_ByRows_ST = iMiddle
 862                   Exit Function
 863                ElseIf CLng(InputArray(LookupRow, iMiddle)) < vFind Then
 864                   iLBound = iMiddle + 1
 865                Else
 866                   iUBound = iMiddle - 1
 867                End If
 868             Loop Until iLBound > iUBound
 869         Case "double"
 870             Do
 871                iMiddle = (iLBound + iUBound) \ 2
 872 
 873                If CDbl(InputArray(LookupRow, iMiddle)) = vFind Then
 874                   BinarySearch_ByRows_ST = iMiddle
 875                   Exit Function
 876                ElseIf CDbl(InputArray(LookupRow, iMiddle)) < vFind Then
 877                   iLBound = iMiddle + 1
 878                Else
 879                   iUBound = iMiddle - 1
 880                End If
 881             Loop Until iLBound > iUBound
 882         Case Else
 883             Do
 884                iMiddle = (iLBound + iUBound) \ 2
 885 
 886                If InputArray(LookupRow, iMiddle) = vFind Then
 887                   BinarySearch_ByRows_ST = iMiddle
 888                   Exit Function
 889                ElseIf InputArray(LookupRow, iMiddle) < vFind Then
 890                   iLBound = iMiddle + 1
 891                Else
 892                   iUBound = iMiddle - 1
 893                End If
 894             Loop Until iLBound > iUBound
 895     End Select
 896 
 897     BinarySearch_ByRows_ST = -1
 898 End Function
 899 
 900 ' //////////////////////////////////////////////////////////////
 901 ''' // SEQUENTIAL SEARCH ARRAY - VARIANT
 902 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 903 ''' // Use to find first occurance of 1 value within a single dimensional array by stupidly looping through it.
 904 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
 905 ''' // Input: Array to search in, Value to find, sType as string indicating whether to compare strings, longs or doubles.
 906 ''' // Returns: Index position of value found or -1 in case value was not found.
 907 Public Function SequentialSearch(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef sType As String) As Long
 908 Dim i As Long
 909 Dim iLBound As Long
 910 Dim iUBound As Long
 911 Dim vFind As Variant
 912 
 913     If LCase(sType) = "string" Then
 914         vFind = CStr(sFind)
 915     ElseIf LCase(sType) = "double" Then
 916         vFind = CDbl(sFind)
 917     ElseIf LCase(sType) = "long" Then
 918         vFind = CLng(sFind)
 919     Else
 920         vFind = sFind
 921     End If
 922 
 923     If Not IsArray(InputArray) Then Exit Function
 924 
 925     iLBound = LBound(InputArray)
 926     iUBound = UBound(InputArray)
 927 
 928     For i = iLBound To iUBound
 929        If InputArray(i) = vFind Then SequentialSearch = i: Exit Function
 930     Next i
 931 
 932     SequentialSearch = -1
 933 End Function
 934 
 935 ' //////////////////////////////////////////////////////////////
 936 ''' // SEQUENTIAL SEARCH ARRAY (ANY DIMENSION) - VARIANT
 937 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 938 ''' // Use to find first occurance of 1 value within a multi dimensional array by stupidly looping through it.
 939 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
 940 ''' // Input: Array to search in, Value to find, row number to lookup search value in, sType as string indicating whether to compare strings, longs or doubles.
 941 ''' // Returns: Index position of value found or -1 in case value was not found.
 942 Public Function SequentialSearch_ByRows(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef LookupRow As Long, ByRef sType As String) As Long
 943 Dim i As Long
 944 Dim iLBound As Long
 945 Dim iUBound As Long
 946 Dim vFind As Variant
 947 
 948     If LCase(sType) = "string" Then
 949         vFind = CStr(sFind)
 950     ElseIf LCase(sType) = "double" Then
 951         vFind = CDbl(sFind)
 952     ElseIf LCase(sType) = "long" Then
 953         vFind = CLng(sFind)
 954     Else
 955         vFind = sFind
 956     End If
 957 
 958    If Not IsArray(InputArray) Then Exit Function
 959 
 960    iLBound = LBound(InputArray, 2)
 961    iUBound = UBound(InputArray, 2)
 962 
 963    For i = iLBound To iUBound
 964       If InputArray(LookupRow, i) = vFind Then SequentialSearch_ByRows = i: Exit Function
 965    Next i
 966 
 967    SequentialSearch_ByRows = -1
 968 End Function
 969 
 970 ' //////////////////////////////////////////////////////////////
 971 ''' // SEQUENTIAL SEARCH ARRAY (ANY DIMENSION) FROM POSITION - VARIANT
 972 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 973 ''' // Use to find first occurance of 1 value within a multi dimensional array by stupidly looping through it. The search starts at a given position.
 974 ''' // You can use this fct. in conjunction with fct. SequentialSearch_ByRows() or even the Binary Search. The first call might lookup position of the first value whereas
 975 ''' // a subssequent call to this function might start from position of first value for finding the value of interest.
 976 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
 977 ''' // Input: Array to search in, Value to find, row number to lookup search value in, position to start searching, sType as string indicating whether to compare strings, longs or doubles.
 978 ''' // Returns: Index position of value found or -1 in case value was not found.
 979 Public Function SequentialSearch_ByRows_StartPos(ByRef InputArray As Variant, ByRef vFind As Variant, ByRef LookupRow As Long, ByRef StartPos As Long, ByRef sType As String) As Long
 980 Dim i As Long
 981 Dim iLBound As Long
 982 Dim iUBound As Long
 983 Dim vFind As Variant
 984 
 985     If LCase(sType) = "string" Then
 986         vFind = CStr(sFind)
 987     ElseIf LCase(sType) = "double" Then
 988         vFind = CDbl(sFind)
 989     ElseIf LCase(sType) = "long" Then
 990         vFind = CLng(sFind)
 991     Else
 992         vFind = sFind
 993     End If
 994 
 995     If Not IsArray(vArray) Then Exit Function
 996 
 997     iLBound = LBound(InputArray, 2)
 998     iUBound = UBound(InputArray, 2)
 999 
1000     For i = StartPos To iUBound
1001        If InputArray(LookupRow, i) = vFind Then SequentialSearch_ByRows_StartPos = i: Exit Function
1002     Next i
1003 
1004     SequentialSearch_ByRows_StartPos = -1
1005 End Function
1006 
1007 
1008 
1009 ' //////////////////////////////////////////////////////////////
1010 ''' // SEQUENTIAL SEARCH ARRAY STRONG TYPED - VARIANT
1011 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
1012 ''' // Use to find first occurance of 1 value within a single dimensional array by stupidly looping through it.
1013 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
1014 ''' // Input: Array to search in, Value to find, sType as string indicating whether to compare strings, longs or doubles.
1015 ''' // Returns: Index position of value found or -1 in case value was not found.
1016 ''' // Note: This fct. performs a comparison between strongly typed parameters.
1017 Public Function SequentialSearch_ST(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef sType As String) As Long
1018 Dim i As Long
1019 Dim iLBound As Long
1020 Dim iUBound As Long
1021 Dim vFind As Variant
1022 
1023     If LCase(sType) = "string" Then
1024         vFind = CStr(sFind)
1025     ElseIf LCase(sType) = "double" Then
1026         vFind = CDbl(sFind)
1027     ElseIf LCase(sType) = "long" Then
1028         vFind = CLng(sFind)
1029     Else
1030         vFind = sFind
1031     End If
1032 
1033     If Not IsArray(InputArray) Then Exit Function
1034 
1035     iLBound = LBound(InputArray)
1036     iUBound = UBound(InputArray)
1037 
1038     Select Case LCase(sType)
1039         Case "string"
1040             For i = iLBound To iUBound
1041                If CStr(InputArray(i)) = vFind Then SequentialSearch_ST = i: Exit Function
1042             Next i
1043         Case "long"
1044             For i = iLBound To iUBound
1045                If CLng(InputArray(i)) = vFind Then SequentialSearch_ST = i: Exit Function
1046             Next i
1047         Case "double"
1048             For i = iLBound To iUBound
1049                If CDbl(InputArray(i)) = vFind Then SequentialSearch_ST = i: Exit Function
1050             Next i
1051         Case Else
1052             For i = iLBound To iUBound
1053                If InputArray(i) = vFind Then SequentialSearch_ST = i: Exit Function
1054             Next i
1055     End Select
1056 
1057     SequentialSearch_ST = -1
1058 End Function
1059 
1060 ' //////////////////////////////////////////////////////////////
1061 ''' // SEQUENTIAL SEARCH ARRAY (ANY DIMENSION) STRONG TYPED - VARIANT
1062 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
1063 ''' // Use to find first occurance of 1 value within a multi dimensional array by stupidly looping through it.
1064 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
1065 ''' // Input: Array to search in, Value to find, row number to lookup search value in, sType as string indicating whether to compare strings, longs or doubles.
1066 ''' // Returns: Index position of value found or -1 in case value was not found.
1067 ''' // Note: This fct. performs a comparison between strongly typed parameters.
1068 Public Function SequentialSearch_ByRows_ST(ByRef InputArray As Variant, ByRef sFind As Variant, ByRef LookupRow As Long, ByRef sType As String) As Long
1069 Dim i As Long
1070 Dim iLBound As Long
1071 Dim iUBound As Long
1072 Dim vFind As Variant
1073 
1074     If LCase(sType) = "string" Then
1075         vFind = CStr(sFind)
1076     ElseIf LCase(sType) = "double" Then
1077         vFind = CDbl(sFind)
1078     ElseIf LCase(sType) = "long" Then
1079         vFind = CLng(sFind)
1080     Else
1081         vFind = sFind
1082     End If
1083 
1084    If Not IsArray(InputArray) Then Exit Function
1085 
1086    iLBound = LBound(InputArray, 2)
1087    iUBound = UBound(InputArray, 2)
1088 
1089    Select Case LCase(sType)
1090         Case "string"
1091             For i = iLBound To iUBound
1092                If CStr(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_ST = i: Exit Function
1093             Next i
1094         Case "long"
1095             For i = iLBound To iUBound
1096                If CLng(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_ST = i: Exit Function
1097             Next i
1098         Case "double"
1099             For i = iLBound To iUBound
1100                If CDbl(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_ST = i: Exit Function
1101             Next i
1102         Case Else
1103             For i = iLBound To iUBound
1104                If InputArray(LookupRow, i) = vFind Then SequentialSearch_ByRows_ST = i: Exit Function
1105             Next i
1106    End Select
1107 
1108    SequentialSearch_ByRows_ST = -1
1109 End Function
1110 
1111 ' //////////////////////////////////////////////////////////////
1112 ''' // SEQUENTIAL SEARCH ARRAY (ANY DIMENSION) FROM POSITION - STRONG TYPED - VARIANT
1113 ' \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
1114 ''' // Use to find first occurance of 1 value within a multi dimensional array by stupidly looping through it. The search starts at a given position.
1115 ''' // You can use this fct. in conjunction with fct. SequentialSearch_ByRows() or even the Binary Search. The first call might lookup position of the first value whereas
1116 ''' // a subssequent call to this function might start from position of first value for finding the value of interest.
1117 ''' // Can be used for arrays having more than 1 unique entry within SearchCol; position of 1st one will be returned.
1118 ''' // Input: Array to search in, Value to find, row number to lookup search value in, position to start searching, sType as string indicating whether to compare strings, longs or doubles.
1119 ''' // Returns: Index position of value found or -1 in case value was not found.
1120 ''' // Note: This fct. performs a comparison between strongly typed parameters.
1121 Public Function SequentialSearch_ByRows_StartPos_ST(ByRef InputArray As Variant, ByRef vFind As Variant, ByRef LookupRow As Long, ByRef StartPos As Long, ByRef sType As String) As Long
1122 Dim i As Long
1123 Dim iLBound As Long
1124 Dim iUBound As Long
1125 Dim vFind As Variant
1126 
1127     If LCase(sType) = "string" Then
1128         vFind = CStr(sFind)
1129     ElseIf LCase(sType) = "double" Then
1130         vFind = CDbl(sFind)
1131     Else
1132         vFind = CLng(sFind)
1133     End If
1134 
1135     If Not IsArray(vArray) Then Exit Function
1136 
1137     iLBound = LBound(InputArray, 2)
1138     iUBound = UBound(InputArray, 2)
1139 
1140    Select Case LCase(sType)
1141         Case "string"
1142             For i = StartPos To iUBound
1143                If CStr(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_StartPos_ST = i: Exit Function
1144             Next i
1145         Case "long"
1146             For i = StartPos To iUBound
1147                If CLng(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_StartPos_ST = i: Exit Function
1148             Next i
1149         Case "double"
1150             For i = StartPos To iUBound
1151                If CDbl(InputArray(LookupRow, i)) = vFind Then SequentialSearch_ByRows_StartPos_ST = i: Exit Function
1152             Next i
1153         Case Else
1154             For i = StartPos To iUBound
1155                If InputArray(LookupRow, i) = vFind Then SequentialSearch_ByRows_StartPos_ST = i: Exit Function
1156             Next i
1157     End Select
1158 
1159     SequentialSearch_ByRows_StartPos_ST = -1
1160 End Function