1 Option Private Module
   2 
   3 
   4 Sub test_ShellSort_Single_Dim()
   5 Dim TMP_Array(7)
   6 
   7     TMP_Array(0) = "Kalender"
   8     TMP_Array(1) = "Haus"
   9     TMP_Array(2) = "Angel"
  10     TMP_Array(3) = "Khlschrank"
  11     TMP_Array(4) = "Buch"
  12     TMP_Array(5) = "Xylophon"
  13     TMP_Array(6) = "Qu�lgeist"
  14     TMP_Array(7) = "Dach"
  15 
  16     Call ShellSortSingle_Dimension(TMP_Array, True)
  17     MsgBox Join(TMP_Array, ",")
  18 
  19 End Sub
  20 
  21 
  22 Sub test_BinarySearch()
  23 Dim sFind As Variant
  24 Dim r As Long, lr As Long
  25 Dim WS As Worksheet
  26 Dim WS_Result As Worksheet
  27 
  28     Set WS_Result = ThisWorkbook.Worksheets("ArrayResult")
  29     lr = Tools.Get_Last_Row(WS_Result)
  30     WS_Result.Activate
  31     WS_Result.Range(Cells(2, 2), Cells(lr, 2)).Clear
  32 
  33     Set WS = ThisWorkbook.Worksheets("ArrayData")
  34     lr = Tools.Get_Last_Row(WS)
  35 
  36     ReDim TMP_Array(lr - 2)
  37 
  38     For i = 2 To lr
  39         TMP_Array(i - 2) = WS.Cells(i, 2).Value
  40     Next
  41     sFind = TMP_Array(134)
  42 
  43     Call ShellSortSingle_Dimension_Double(TMP_Array, True)
  44     r = BinarySearch(TMP_Array, sFind, "long")
  45 
  46     MsgBox "Found " & sFind & " at Position: " & r
  47 
  48     For i = 2 To lr
  49         WS_Result.Cells(i, 2).Value = TMP_Array(i - 2)
  50         Application.StatusBar = "Writing sorted array: " & i & " of " & lr
  51     Next
  52     Application.StatusBar = False
  53 End Sub
  54 
  55 
  56 Sub test_UniqueArray()
  57 Dim tmpArray As Variant
  58 Dim r As Long, lr As Long, maxArray As Long
  59 Dim WS As Worksheet
  60 Dim WS_Result As Worksheet
  61 
  62     Set WS_Result = ThisWorkbook.Worksheets("ArrayResult")
  63     lr = Tools.Get_Last_Row(WS_Result)
  64     WS_Result.Activate
  65     WS_Result.Range(Cells(2, 3), Cells(lr, 3)).Clear
  66 
  67     Set WS = ThisWorkbook.Worksheets("ArrayData")
  68     lr = Tools.Get_Last_Row(WS)
  69 
  70     ReDim TMP_Array(lr - 2)
  71 
  72     For i = 2 To lr
  73         TMP_Array(i - 2) = WS.Cells(i, 2).Value
  74     Next
  75 
  76     Call arrayTools.ShellSortSingle_Dimension_Double(TMP_Array, True)
  77     tmpArray = arrayTools.Array_Unique(TMP_Array)
  78     maxArray = UBound(tmpArray)
  79 
  80     MsgBox "Sorted array and made a unique array"
  81 
  82     For i = 2 To maxArray + 2
  83         WS_Result.Cells(i, 3).Value = tmpArray(i - 2)
  84         Application.StatusBar = "Writing sorted array: " & i & " of " & maxArray
  85     Next
  86     Application.StatusBar = False
  87 End Sub