Here's one approach:
Sub Tester()
Dim dict As Object, i As Long, dt As Date, itms, e
Set dict = CreateObject("scripting.dictionary")
'some test data
For i = 1 To 10
dt = Now - Application.RandBetween(500, 5000)
dict.Add "Object_" & i, GetTestObject("Name_" & i, dt, "Job_" & i)
Next i
itms = dict.items
'Stop
SortObjects itms, "BirthDate"
Debug.Print "---------Birthdate-------"
For Each e In itms
Debug.Print e.Name, e.BirthDate, e.JobName
Next e
SortObjects itms, "JobName"
Debug.Print "---------JobName-------"
For Each e In itms
Debug.Print e.Name, e.BirthDate, e.JobName
Next e
End Sub
Function GetTestObject(nm As String, dt As Date, jb As String)
Dim obj As New clsTest
obj.Name = nm
obj.BirthDate = dt
obj.JobName = jb
Set GetTestObject = obj
End Function
'Sort an array of objects using a given property 'propName'
Sub SortObjects(list, propName As String)
Dim First As Long, Last As Long, i As Long, j As Long, vTmp, oTmp As Object, arrComp()
First = LBound(list)
Last = UBound(list)
'fill the "compare" array...
ReDim arrComp(First To Last)
For i = First To Last
arrComp(i) = CallByName(list(i), propName, VbGet)
Next i
'now sort by comparing on `arrComp` not `list`
For i = First To Last - 1
For j = i + 1 To Last
If arrComp(i) > arrComp(j) Then
vTmp = arrComp(j) 'swap positions in the "comparison" array
arrComp(j) = arrComp(i)
arrComp(i) = vTmp
Set oTmp = list(j) '...and in the original array
Set list(j) = list(i)
Set list(i) = oTmp
End If
Next j
Next i
End Sub