Comb Sort in VBA

Question

Playing off Robust Bubble Sort in VBA and as suggested by @Henrik, I took a look at comb sort and tried to create an algorithm based on the documentation solely on Wikipedia.

Basically, the first procedure is just for the testing:

1. Take a string of numbers and create an array
2. Sort the array ascending or descending
3. Build an output string and print it next to the input string

Sample input would look like this:

698 15 641 370 388 738 334 980 670
741 287 61 203 176 161 78 746 832
877 180 825 560 802 726 205 344 293
987 441 727 932 26 16 568 963 60
589 538 76 152 663 867 96 209 611
772 999 957 635 910 554 611 36 689
292 473 796 411 560 569 539 553 97
582 17 972 184 58 513 694 329 394
81 609 383 724 384 27 426 454 343
418 286 583 774 336 996 849 297 299

---

Option Explicit
Public Sub TestCombSort()
 Const DELIMITER As String = " "
 Dim targetSheet As Worksheet
 Set targetSheet = ActiveSheet
 Dim numberOfArrays As Long
 numberOfArrays = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
 Dim inputValue As String
 Dim outputValue As String
 Dim targetRow As Long
 Dim index As Long
 Dim rawArray As Variant
 Dim numberArray() As Double
 For targetRow = 1 To numberOfArrays
 inputValue = targetSheet.Cells(targetRow, 1)
 If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
 rawArray = GetArrayFromCell(inputValue, DELIMITER)
 'Create a sort for alphabetic strings? If so ->
 'Create function to run only if numbers?
 ReDim numberArray(LBound(rawArray) To UBound(rawArray))
 For index = LBound(rawArray) To UBound(rawArray)
 If Not IsNumeric(rawArray(index)) Then GoTo NextIteration
 numberArray(index) = CDbl(rawArray(index))
 Next
 CombSortNumbers numberArray, False
 outputValue = CreateOutputString(numberArray(), DELIMITER)
 targetSheet.Cells(targetRow, 2) = outputValue
NextIteration:
 Next
End Sub
Private Function GetArrayFromCell(ByVal inputValue As String, ByVal DELIMITER As String) As Variant
 GetArrayFromCell = Split(inputValue, DELIMITER)
End Function
Private Sub CombSortNumbers(ByRef numberArray() As Double, Optional ByVal sortAscending As Boolean = True)
 Const SHRINK As Double = 1.3
 Dim initialSize As Long
 initialSize = UBound(numberArray())
 Dim gap As Long
 gap = initialSize
 Dim index As Long
 Dim isSorted As Boolean
 Do While gap > 1 And Not isSorted
 gap = Int(gap / SHRINK)
 If gap > 1 Then
 isSorted = False
 Else
 gap = 1
 isSorted = True
 End If
 index = 0
 Do While index + gap <= initialSize
 If sortAscending Then
 If numberArray(index) > numberArray(index + gap) Then
 SwapElements numberArray, index, index + gap
 isSorted = False
 End If
 Else
 If numberArray(index) < numberArray(index + gap) Then
 SwapElements numberArray, index, index + gap
 isSorted = False
 End If
 End If
 index = index + 1
 Loop
 Loop
End Sub
Private Sub SwapElements(ByRef numberArray() As Double, ByVal i As Long, ByVal j As Long)
 Dim temporaryHolder As Double
 temporaryHolder = numberArray(i)
 numberArray(i) = numberArray(j)
 numberArray(j) = temporaryHolder
End Sub
Private Function CreateOutputString(ByVal numberArray As Variant, ByVal DELIMITER As String) As String
 Dim index As Long
 For index = LBound(numberArray) To UBound(numberArray) - 1
 CreateOutputString = CreateOutputString & numberArray(index) & DELIMITER
 Next
 CreateOutputString = CreateOutputString & numberArray(UBound(numberArray))
End Function

Answer 1

While this is probably the single "warranted" use of GoTo given the lack of a Continue keyword in VBA:

 For targetRow = 1 To numberOfArrays
 inputValue = targetSheet.Cells(targetRow, 1)
 If Replace(inputValue, DELIMITER, vbNullString) = vbNullString Then GoTo NextIteration
 rawArray = GetArrayFromCell(inputValue, DELIMITER)
 'Create a sort for alphabetic strings? If so ->
 'Create function to run only if numbers?
 ReDim numberArray(LBound(rawArray) To UBound(rawArray))
 For index = LBound(rawArray) To UBound(rawArray)
 If Not IsNumeric(rawArray(index)) Then GoTo NextIteration
 numberArray(index) = CDbl(rawArray(index))
 Next
 CombSortNumbers numberArray, False
 outputValue = CreateOutputString(numberArray(), DELIMITER)
 targetSheet.Cells(targetRow, 2) = outputValue 
NextIteration:
 Next

...I would still replace at least the first one with an indentation level:

 For targetRow = 1 To numberOfArrays
 inputValue = targetSheet.Cells(targetRow, 1)
 If Replace(inputValue, DELIMITER, vbNullString) <> vbNullString Then 
 rawArray = GetArrayFromCell(inputValue, DELIMITER)
 'Create a sort for alphabetic strings? If so ->
 'Create function to run only if numbers?
 ReDim numberArray(LBound(rawArray) To UBound(rawArray))
 For index = LBound(rawArray) To UBound(rawArray)
 If Not IsNumeric(rawArray(index)) Then GoTo NextIteration
 numberArray(index) = CDbl(rawArray(index))
 Next
 CombSortNumbers numberArray, False
 outputValue = CreateOutputString(numberArray(), DELIMITER)
 targetSheet.Cells(targetRow, 2) = outputValue
 End If
NextIteration:
 Next

Now, that second GoTo is harder to get rid of. What's that inner loop doing exactly? We're validating whether every item in the current array is a numeric value - sounds like a task that can be extracted into its own function:

Private Function IsEveryItemNumeric(ByRef rawArray As Variant, ByRef numberArray As Double()) As Boolean
 ReDim numberArray(LBound(rawArray) To UBound(rawArray))
 Dim rawValue As Variant
 Dim index As Long
 For index = LBound(rawArray) To UBound(rawArray)
 rawValue = rawArray(index)
 If Not IsNumeric(rawValue) Then
 IsEveryItemNumeric = False
 Exit Function
 Else
 numberArray(index) = CDbl(rawValue)
 End If
 Next
 IsEveryItemNumeric = True
End Function

Now, your loop looks like this, and GoTo is gone:

For targetRow = 1 To numberOfArrays
 inputValue = targetSheet.Cells(targetRow, 1)
 If Replace(inputValue, DELIMITER, vbNullString) <> vbNullString Then 
 rawArray = GetArrayFromCell(inputValue, DELIMITER)
 If IsEveryItemNumeric(rawArray, numberArray) Then
 CombSortNumbers numberArray, False
 outputValue = CreateOutputString(numberArray(), DELIMITER)
 targetSheet.Cells(targetRow, 2) = outputValue
 End If
 End If
Next

Rest looks pretty neat :)