4
\$\begingroup\$

Previously: Comb Sort in VBA

I've been running two different comb sorts (on arrays) depending on whether I want to sort numbers or strings and I figured I would give using Variant a try instead. source here.

Additionally, I wanted to sort 1- or 2- dimensional arrays on a specific key column, but keeping rows together.

So, this sorts 2D arrays based on a key column.

code:

Private Sub CombSortArray(ByRef dataArray As Variant, Optional ByVal numberOfColumns As Long = 1, Optional ByVal sortKeyColumn As Long = 1, Optional ByVal sortAscending As Boolean = True)
    Const SHRINK As Double = 1.3
    Dim initialSize As Long
    initialSize = UBound(dataArray, 1)
    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 = 1
        Do While index + gap <= initialSize
            If sortAscending Then
                If dataArray(index, sortKeyColumn) > dataArray(index + gap, sortKeyColumn) Then
                    SwapElements dataArray, numberOfColumns, index, index + gap
                    isSorted = False
                End If
            Else
                If dataArray(index, sortKeyColumn) < dataArray(index + gap, sortKeyColumn) Then
                    SwapElements dataArray, numberOfColumns, index, index + gap
                    isSorted = False
                End If
            End If
            index = index + 1
        Loop
    Loop

End Sub

Private Sub SwapElements(ByRef dataArray As Variant, ByVal numberOfColumns As Long, ByVal i As Long, ByVal j As Long)
    Dim temporaryHolder As Variant
    Dim index As Long
    For index = 1 To numberOfColumns
        temporaryHolder = dataArray(i, index)
        dataArray(i, index) = dataArray(j, index)
        dataArray(j, index) = temporaryHolder
    Next
End Sub

And my testing procedure -

Option Explicit

Public Sub TestCombSort()
    Const SORT_KEY_COLUMN As Long = 1

    Dim targetSheet As Worksheet
    Set targetSheet = ActiveSheet
    Dim dataArray As Variant
    Dim lastRow As Long
    lastRow = targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Row
    Dim lastColumn As Long
    lastColumn = targetSheet.Cells(1, targetSheet.Columns.Count).End(xlToLeft).Column

    dataArray = targetSheet.Range(targetSheet.Cells(1, 1), targetSheet.Cells(lastRow, lastColumn))
    Dim index As Long

    CombSortArray dataArray, lastColumn, SORT_KEY_COLUMN, True
    targetSheet.Range(targetSheet.Cells(1, lastColumn + 1), targetSheet.Cells(lastRow, (lastColumn * 2))) = dataArray

End Sub

And some delimited sample data:

47,H,84
40,J,54
30,L,33
28,N,28
52,P,50
11,R,75
79,T,29
46,V,34
65,X,84
36,Z,42
5,bb,2
19,dd,81
25,ff,98
66,hh,96
65,kk,68
33,mm,80
63,oo,67
52,qq,22

Something I have noticed is that rubberduck is telling me both procedures can be functions, but I'm not sure why I would do that.

\$\endgroup\$

0

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Browse other questions tagged or ask your own question.