This one helps me.
Please note that I am not an author. The original source is mentioned in the function header, but this site seems to have already disappeared.
The part that makes it work is VB, a little-known or often overlooked command CallByName.
Public Function SortItemCollection(col As Collection, ByVal sPropertyName As String, _
ByVal bolSortAscending As Boolean, ByVal bolCompareNumeric As Boolean) As Collection
'
'Purpose : Sort a collection of objects using one of the object properties
' as the sorting field. That property must be of a primitive
' data type (string or numeric)
'
'Prereq. : !!! Important !!! The scope of property sPropertyName needs to be
' declared as Public.
'Parameter: -
'Returns : -
'Note : The idea is to have a class that is added to a collection object.
' Pass that collection to this function below and the property name
' is the 'field' within the class that is to be sorted on.
'
' Author: Original author unknown, refined by Branko Pedisic
' Source: http://www.ifnottruethenfalse.com/sort-a-collection-object-in-vb6/
' Changed: 19.03.2014
' - Source reformatted and variable names changed to accommodate my
' naming conventions.
'
Dim colNew As Collection
Dim oCurrent As Object
Dim oCompare As Object
Dim lCompareIndex As Long
Dim sCurrent As String
Dim sCompare As String
Dim bolGreaterValueFound As Boolean
'make a copy of the collection, ripping through it one item
'at a time, adding to new collection in right order...
Set colNew = New Collection
For Each oCurrent In col
'get value of current item...
sCurrent = CallByName(oCurrent, sPropertyName, VbGet)
'setup for compare loop
bolGreaterValueFound = False
lCompareIndex = 0
For Each oCompare In colNew
lCompareIndex = lCompareIndex + 1
sCompare = CallByName(oCompare, sPropertyName, VbGet)
'optimization - instead of doing this for every iteration,
'have 2 different loops...
If bolCompareNumeric = True Then
'this means we are looking for a numeric sort order...
If (bolSortAscending = True) Then
If Val(sCurrent) < Val(sCompare) Then
'found an item in compare collection that is greater...
'add it to the new collection...
bolGreaterValueFound = True
colNew.Add oCurrent, , lCompareIndex
Exit For
End If
Else
If Val(sCurrent) > Val(sCompare) Then
'found an item in compare collection that is greater...
'add it to the new collection...
bolGreaterValueFound = True
colNew.Add oCurrent, , lCompareIndex
Exit For
End If
End If
Else '// If bolCompareNumeric = True
'this means we are looking for a string sort...
If (bolSortAscending = True) Then
If sCurrent < sCompare Then
'found an item in compare collection that is greater...
'add it to the new collection...
bolGreaterValueFound = True
colNew.Add oCurrent, , lCompareIndex
Exit For
End If
Else
If sCurrent > sCompare Then
'found an item in compare collection that is greater...
'add it to the new collection...
bolGreaterValueFound = True
colNew.Add oCurrent, , lCompareIndex
Exit For
End If
End If
End If '// If bolCompareNumeric = True
Next oCompare
'if we didn't find something bigger, just add it to the end of
'the new collection...
If bolGreaterValueFound = False Then
colNew.Add oCurrent
End If
Next oCurrent
'return the new collection...
Set SortItemCollection = colNew
Set colNew = Nothing
End Function