vbacollections

How do I sort a collection?


Does anyone know how to sort a collection in VBA?


Solution

  • Late to the game... here's an implementation of the MergeSort algorithm in VBA for both Arrays and Collections. I tested the performance of this implementation against the BubbleSort implementation in the accepted answer using randomly generated strings. The chart below summarizes the results, i.e. that you should not use BubbleSort to sort a VBA collection.

    Performance Comparison

    You can download the source code from my GitHub Repository or just copy/paste the source code below into the appropriate modules.

    For a collection col, just call Collections.sort col.

    Collections module

    'Sorts the given collection using the Arrays.MergeSort algorithm.
    ' O(n log(n)) time
    ' O(n) space
    Public Sub sort(col As collection, Optional ByRef c As IVariantComparator)
        Dim a() As Variant
        Dim b() As Variant
        a = Collections.ToArray(col)
        Arrays.sort a(), c
        Set col = Collections.FromArray(a())
    End Sub
    
    'Returns an array which exactly matches this collection.
    ' Note: This function is not safe for concurrent modification.
    Public Function ToArray(col As collection) As Variant
        Dim a() As Variant
        ReDim a(0 To col.count)
        Dim i As Long
        For i = 0 To col.count - 1
            a(i) = col(i + 1)
        Next i
        ToArray = a()
    End Function
    
    'Returns a Collection which exactly matches the given Array
    ' Note: This function is not safe for concurrent modification.
    Public Function FromArray(a() As Variant) As collection
        Dim col As collection
        Set col = New collection
        Dim element As Variant
        For Each element In a
            col.Add element
        Next element
        Set FromArray = col
    End Function
    

    Arrays module

        Option Compare Text
    Option Explicit
    Option Base 0
    
    Private Const INSERTIONSORT_THRESHOLD As Long = 7
    
    'Sorts the array using the MergeSort algorithm (follows the Java legacyMergesort algorithm
    'O(n*log(n)) time; O(n) space
    Public Sub sort(ByRef a() As Variant, Optional ByRef c As IVariantComparator)
    
        If c Is Nothing Then
            MergeSort copyOf(a), a, 0, length(a), 0, Factory.newNumericComparator
        Else
            MergeSort copyOf(a), a, 0, length(a), 0, c
        End If
    End Sub
    
    
    Private Sub MergeSort(ByRef src() As Variant, ByRef dest() As Variant, low As Long, high As Long, off As Long, ByRef c As IVariantComparator)
        Dim length As Long
        Dim destLow As Long
        Dim destHigh As Long
        Dim mid As Long
        Dim i As Long
        Dim p As Long
        Dim q As Long
    
        length = high - low
    
        ' insertion sort on small arrays
        If length < INSERTIONSORT_THRESHOLD Then
            i = low
            Dim j As Long
            Do While i < high
                j = i
                Do While True
                    If (j <= low) Then
                        Exit Do
                    End If
                    If (c.compare(dest(j - 1), dest(j)) <= 0) Then
                        Exit Do
                    End If
                    swap dest, j, j - 1
                    j = j - 1 'decrement j
                Loop
                i = i + 1 'increment i
            Loop
            Exit Sub
        End If
    
        'recursively sort halves of dest into src
        destLow = low
        destHigh = high
        low = low + off
        high = high + off
        mid = (low + high) / 2
        MergeSort dest, src, low, mid, -off, c
        MergeSort dest, src, mid, high, -off, c
    
        'if list is already sorted, we're done
        If c.compare(src(mid - 1), src(mid)) <= 0 Then
            copy src, low, dest, destLow, length - 1
            Exit Sub
        End If
    
        'merge sorted halves into dest
        i = destLow
        p = low
        q = mid
        Do While i < destHigh
            If (q >= high) Then
               dest(i) = src(p)
               p = p + 1
            Else
                'Otherwise, check if p<mid AND src(p) preceeds scr(q)
                'See description of following idom at: https://stackoverflow.com/a/3245183/3795219
                Select Case True
                   Case p >= mid, c.compare(src(p), src(q)) > 0
                       dest(i) = src(q)
                       q = q + 1
                   Case Else
                       dest(i) = src(p)
                       p = p + 1
                End Select
            End If
    
            i = i + 1
        Loop
    
    End Sub
    

    IVariantComparator class

    Option Explicit
    
    'The IVariantComparator provides a method, compare, that imposes a total ordering over a collection _
    of variants. A class that implements IVariantComparator, called a Comparator, can be passed to the _
    Arrays.sort and Collections.sort methods to precisely control the sort order of the elements.
    
    'Compares two variants for their sort order. Returns -1 if v1 should be sorted ahead of v2; +1 if _
    v2 should be sorted ahead of v1; and 0 if the two objects are of equal precedence. This function _
    should exhibit several necessary behaviors: _
      1.) compare(x,y)=-(compare(y,x) for all x,y _
      2.) compare(x,y)>= 0 for all x,y _
      3.) compare(x,y)>=0 and compare(y,z)>=0 implies compare(x,z)>0 for all x,y,z
    Public Function compare(ByRef v1 As Variant, ByRef v2 As Variant) As Long
    End Function
    

    If no IVariantComparator is provided to the sort methods, then the natural ordering is assumed. However, if you need to define a different sort order (e.g. reverse) or if you want to sort custom objects, you can implement the IVariantComparator interface. For example, to sort in reverse order, just create a class called CReverseComparator with the following code:

    CReverseComparator class

    Option Explicit
    
    Implements IVariantComparator
    
    Public Function IVariantComparator_compare(v1 As Variant, v2 As Variant) As Long
        IVariantComparator_compare = v2-v1
    End Function
    

    Then call the sort function as follows: Collections.sort col, New CReverseComparator

    Bonus Material: For a visual comparison of the performance of different sorting algorithms check out https://www.toptal.com/developers/sorting-algorithms/