HiveBrain v1.2.0
Get Started
← Back to all entries
snippetMinor

Comb Sort in VBA

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
sortcombvba

Problem

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:

  • Take a string of numbers and create an array



  • Sort the array ascending or descending



  • 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

Solution

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 :)

Code Snippets

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
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
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
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

Context

StackExchange Code Review Q#145862, answer score: 5

Revisions (0)

No revisions yet.