Sorting Dictionary by nested class objects data [VBA]

I have a Dictionary with a ID (string) as Key and nested Class object as its Item. Dictionary looks like this:

Key: "ID1", Item: obj1
Key: "ID2", Item: obj2
Key: "ID3", Item: obj3

and so on...

Each class object has fields:

Public Salary As Double
Public Revenue As Double
Public Position As String

Here is the code:

Sub Tester()

    Dim dict As Object, i As Long, itms, e
    Set dict = CreateObject("scripting.dictionary")
    
    'some test data for Dictionary
    For i = 1 To 10
        dict.Add "ID" & i, GetTestObject(i, -i, "Job_" & i)
    Next i
    itms = dict.Items
     
    'Calling sort by "salary"
    SortObjects itms, "Salary"
    
    Debug.Print "---------By Salary (Highest to Lowest)-------"
    For Each e In itms
        Debug.Print e.Salary, e.Revenue, e.Position
    Next e
       
End Sub

Test class objects returned by Function:

Function GetTestObject(slr As Long, rvn As Long, pst As String)
    Dim obj As New Class1
    obj.Salary = slr
    obj.Revenue = rvn
    obj.Position = pst
    Set GetTestObject = obj
End Function

Sorting of Items in Dictionary done by this:

'Sorting 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

I print the dictionary:

    Debug.Print "---------By Salary (Highest to Lowest)-------"
    For Each e In itms
        Debug.Print e.Salary, e.Revenue, e.Position
    Next e

RESULT:

---------By Salary (Highest to Lowest)-------
 10           -10           Job_10
 9            -9            Job_9
 8            -8            Job_8
 7            -7            Job_7
 6            -6            Job_6
 5            -5            Job_5
 4            -4            Job_4
 3            -3            Job_3
 2            -2            Job_2
 1            -1            Job_1

So, it is sorted correctly by Salary and I printed corresponding values Salary Revenue and Job. And is printed in descending order correctly.

But how can I also print each element with its ID (Key) in sorted order? I got sorted array of Items (objects) and printed. How can I also access and print corresponding ID (Key) of each element in sorted Dicionary of <IDs>, <objects>?

Basically, I got a sorted data of Dictionary but I lost elements connection with their IDs (Keys). How can I resolve?

Solution

As far as I know, a dictionary doesn't guarantee any sorting order. My suggestion is not to sort the dictionary, but an array of the dictionary keys. Use that sorted array to access the elements of the dictionary. The dictionary itself remains untouched.

The code of your tester routine would look like

'Calling sort by "salary"
Dim sortedkeys, key
sortedkeys = SortObjects(dict, "Salary", False)
Debug.Print "---------By Salary (Highest to Lowest)-------"
For Each key In sortedkeys
    Dim e As Class1
    Set e = dict(key)
    Debug.Print key, e.Salary, e.Revenue, e.Position
Next key

The sorting routine (it is now a function) that returns the sorted keys keeps the dictionary as it is, reads the keys into an array and sorts that array by reading the given property of the items stored in the dictionary. I added an optional parameter so that the routine can sort ascending or descending - of course you could achieve this also by traveling backwards through the sorted array.

' Sorting the keys of a dictionary using a given property 'propName'
Function SortObjects(dict As Dictionary, propName As String, Optional ascending As Boolean = True) As Variant
    Dim keys
    keys = dict.keys
    
    Dim i As Long, j As Long
    For i = LBound(keys) To UBound(keys) - 1
        For j = i + 1 To UBound(keys)
            Dim v1, v2
            v1 = CallByName(dict(keys(i)), propName, VbGet)
            v2 = CallByName(dict(keys(j)), propName, VbGet)
        
            If (v1 > v2 And ascending) Or (v1 < v2 And Not ascending) Then
                Dim vTmp
                vTmp = keys(j)          'swap positions in the "comparison" array
                keys(j) = keys(i)
                keys(i) = vTmp
            End If
        Next j
    Next i
    SortObjects = keys
End Function

N.B.: I usually add the ID as property to the class itself.