How do I sort a collection?

This is a VBA implementation of the QuickSort algorithm, which is often a better alternative to MergeSort:

Public Sub QuickSortSortableObjects(colSortable As collection, Optional bSortAscending As Boolean = True, Optional iLow1, Optional iHigh1)
    Dim obj1 As Object
    Dim obj2 As Object
    Dim clsSortable As ISortableObject, clsSortable2 As ISortableObject
    Dim iLow2 As Long, iHigh2 As Long
    Dim vKey As Variant
    On Error GoTo PtrExit

    'If not provided, sort the entire collection
    If IsMissing(iLow1) Then iLow1 = 1
    If IsMissing(iHigh1) Then iHigh1 = colSortable.Count

    'Set new extremes to old extremes
    iLow2 = iLow1
    iHigh2 = iHigh1

    'Get the item in middle of new extremes
    Set clsSortable = colSortable.Item((iLow1 + iHigh1) \ 2)
    vKey = clsSortable.vSortKey

    'Loop for all the items in the collection between the extremes
    Do While iLow2 < iHigh2

        If bSortAscending Then
            'Find the first item that is greater than the mid-Contract item
            Set clsSortable = colSortable.Item(iLow2)
            Do While clsSortable.vSortKey < vKey And iLow2 < iHigh1
                iLow2 = iLow2 + 1
                Set clsSortable = colSortable.Item(iLow2)
            Loop

            'Find the last item that is less than the mid-Contract item
            Set clsSortable2 = colSortable.Item(iHigh2)
            Do While clsSortable2.vSortKey > vKey And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
                Set clsSortable2 = colSortable.Item(iHigh2)
            Loop
        Else
            'Find the first item that is less than the mid-Contract item
            Set clsSortable = colSortable.Item(iLow2)
            Do While clsSortable.vSortKey > vKey And iLow2 < iHigh1
                iLow2 = iLow2 + 1
                Set clsSortable = colSortable.Item(iLow2)
            Loop

            'Find the last item that is greater than the mid-Contract item
            Set clsSortable2 = colSortable.Item(iHigh2)
            Do While clsSortable2.vSortKey < vKey And iHigh2 > iLow1
                iHigh2 = iHigh2 - 1
                Set clsSortable2 = colSortable.Item(iHigh2)
            Loop
        End If

        'If the two items are in the wrong order, swap the rows
        If iLow2 < iHigh2 And clsSortable.vSortKey <> clsSortable2.vSortKey Then
            Set obj1 = colSortable.Item(iLow2)
            Set obj2 = colSortable.Item(iHigh2)
            colSortable.Remove iHigh2
            If iHigh2 <= colSortable.Count Then _
                colSortable.Add obj1, Before:=iHigh2 Else colSortable.Add obj1
            colSortable.Remove iLow2
            If iLow2 <= colSortable.Count Then _
                colSortable.Add obj2, Before:=iLow2 Else colSortable.Add obj2
        End If

        'If the Contracters are not together, advance to the next item
        If iLow2 <= iHigh2 Then
            iLow2 = iLow2 + 1
            iHigh2 = iHigh2 - 1
        End If
    Loop

    'Recurse to sort the lower half of the extremes
    If iHigh2 > iLow1 Then QuickSortSortableObjects colSortable, bSortAscending, iLow1, iHigh2

    'Recurse to sort the upper half of the extremes
    If iLow2 < iHigh1 Then QuickSortSortableObjects colSortable, bSortAscending, iLow2, iHigh1

PtrExit:
End Sub

The objects stored in the collection must implement the ISortableObject interface, which must be defined in your VBA project. To do that, add a class module called ISortableObject with the following code:

Public Property Get vSortKey() As Variant
End Property

I want to go a little bit further with igorsp7 QuickSort

If you dont wan't to use special Interface, just for the sake of sorting you can use CallByName function:

Public Sub QuickSortCollection(colSortable As Object, nameOfSortingProperty As String, Optional bSortAscending As Boolean = True, Optional iLow1, Optional iHigh1)
Dim obj1 As Object
Dim obj2 As Object
Dim clsSortable As Object
Dim clsSortable2 As Object
Dim iLow2 As Long, iHigh2 As Long
Dim vKey As Variant
On Error GoTo PtrExit

'If not provided, sort the entire collection
If IsMissing(iLow1) Then iLow1 = 1
If IsMissing(iHigh1) Then iHigh1 = colSortable.Count

'Set new extremes to old extremes
iLow2 = iLow1
iHigh2 = iHigh1

'Get the item in middle of new extremes
Set clsSortable = colSortable.Item((iLow1 + iHigh1) \ 2)
vKey = CallByName(clsSortable, nameOfSortingProperty, VbGet)

'Loop for all the items in the collection between the extremes
Do While iLow2 < iHigh2

    If bSortAscending Then
        'Find the first item that is greater than the mid-Contract item
        Set clsSortable = colSortable.Item(iLow2)
        Do While CallByName(clsSortable, nameOfSortingProperty, VbGet) < vKey And iLow2 < iHigh1
            iLow2 = iLow2 + 1
            Set clsSortable = colSortable.Item(iLow2)
        Loop

        'Find the last item that is less than the mid-Contract item
        Set clsSortable2 = colSortable.Item(iHigh2)
        Do While CallByName(clsSortable2, nameOfSortingProperty, VbGet) > vKey And iHigh2 > iLow1
            iHigh2 = iHigh2 - 1
            Set clsSortable2 = colSortable.Item(iHigh2)
        Loop
    Else
        'Find the first item that is less than the mid-Contract item
        Set clsSortable = colSortable.Item(iLow2)
        Do While CallByName(clsSortable, nameOfSortingProperty, VbGet) > vKey And iLow2 < iHigh1
            iLow2 = iLow2 + 1
            Set clsSortable = colSortable.Item(iLow2)
        Loop

        'Find the last item that is greater than the mid-Contract item
        Set clsSortable2 = colSortable.Item(iHigh2)
        Do While CallByName(clsSortable2, nameOfSortingProperty, VbGet) < vKey And iHigh2 > iLow1
            iHigh2 = iHigh2 - 1
            Set clsSortable2 = colSortable.Item(iHigh2)
        Loop
    End If

    'If the two items are in the wrong order, swap the rows
    If iLow2 < iHigh2 And CallByName(clsSortable, nameOfSortingProperty, VbGet) <> CallByName(clsSortable2, nameOfSortingProperty, VbGet) Then
        Set obj1 = colSortable.Item(iLow2)
        Set obj2 = colSortable.Item(iHigh2)
        colSortable.Remove iHigh2
        If iHigh2 <= colSortable.Count Then _
            colSortable.Add obj1, before:=iHigh2 Else colSortable.Add obj1
        colSortable.Remove iLow2
        If iLow2 <= colSortable.Count Then _
            colSortable.Add obj2, before:=iLow2 Else colSortable.Add obj2
    End If

    'If the Contracters are not together, advance to the next item
    If iLow2 <= iHigh2 Then
        iLow2 = iLow2 + 1
        iHigh2 = iHigh2 - 1
    End If
Loop

'Recurse to sort the lower half of the extremes
If iHigh2 > iLow1 Then Call QuickSortCollection(colSortable, nameOfSortingProperty, bSortAscending, iLow1, iHigh2)

'Recurse to sort the upper half of the extremes
If iLow2 < iHigh1 Then Call QuickSortCollection(colSortable, nameOfSortingProperty, bSortAscending, iLow2, iHigh1)

PtrExit:
End Sub

Also i've changed colSortable to be Object, as I'm using a lot of custom typed collections.

As mentioned, Collections do not have a built in sort feature. I came up with a simpler implementation using VBA Collection's built in After property.

This method loops through each existing item in the Collection, and once the new item (NewItem) comes later than the current loop value (Col.Item(i)) by ASCII comparison, it exits the loop and adds NewItem into that spot.

Private Sub InsertCollectionValueAlphabetically(Col As Collection, NewItem As String)

    Dim i As Long
    
    If Col.Count = 0 Then
        Col.Add NewItem, NewItem  'First value gets added without trying to loop through
        Exit Sub
    End If
    
    For i = 1 To Col.Count
        'Convert to lower case to get predictable behavior after ASCII text comparison
        If (LCase(NewItem) < LCase(Col.Item(i))) Then Exit For
    Next i
    
    If i = 1 Then
        Col.Add NewItem, NewItem, 1
    Else
        Col.Add NewItem, NewItem, , i - 1
    End If
End Sub