How do I sort a collection?

Question

Does anyone know how to sort a collection in VBA?

Answer 1

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.

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/

Answer 2

The code below from this post uses a bubble sort

Sub SortCollection()      Dim cFruit As Collection     Dim vItm As Variant     Dim i As Long, j As Long     Dim vTemp As Variant      Set cFruit = New Collection      'fill the collection     cFruit.Add "Mango", "Mango"     cFruit.Add "Apple", "Apple"     cFruit.Add "Peach", "Peach"     cFruit.Add "Kiwi", "Kiwi"     cFruit.Add "Lime", "Lime"      'Two loops to bubble sort     For i = 1 To cFruit.Count - 1         For j = i + 1 To cFruit.Count             If cFruit(i) > cFruit(j) Then                 'store the lesser item                 vTemp = cFruit(j)                 'remove the lesser item                 cFruit.Remove j                 're-add the lesser item before the                 'greater Item                 cFruit.Add vTemp, vTemp, i             End If         Next j     Next i      'Test it     For Each vItm In cFruit         Debug.Print vItm     Next vItm  End Sub