How to sort dictionary by object property vbscript

Question

I am trying to sort a dictionary with a function that I found online by an object property which is the Id but on this For Each i In dict line I am getting this error message Microsoft VBScript runtime error: Object doesn't support this property or method. I have tried For Each i In dict.Items but I get the same error message with 'dict.Items' I am using a older version of VBScript so it does not have features like dict.Count

VBScript Class:

Class TestClass
    Public ID
    Public TestText
    Private Sub Class_Initialize
            TestText  = ""
    End Sub
End Class

Set gDic = CreateObject("Scripting.Dictionary")


For i = 1 to 5
    Set temp = new TestClass
    temp.ID = i
    temp.TestText = "Test" & i

    gDic.Add i,temp
Next


Set NewDic = SortDict(gDic)
msgbox NewDic.Items()(1).TestText

Sort function:

Function SortDict(ByVal dict)
    Dim i, j, temp
    For Each i In dict
        For Each j In dict
            If(dict.Item(i) <= dict.Item(j)) Then
                temp = dict.Item(i)
                dict.Item(i) = dict.Item(j)
                dict.Item(j) = temp
            End If
        Next
    Next
    Set SortDict = dict
End Function

Answer 1

Try modifying your function to:

Function SortDict(dict)
    Dim i, j, arrKeys, arrItems
    arrKeys = dict.keys                                               'Array containing the keys
    arrItems = dict.Items                                             'Array containing the Items(which are nothing but objects of class TestClass)
    Set tempObj = New TestClass
    For i=0 To UBound(arrItems)-1                                     'From 1st element to the penultimate element
        For j=i+1 To UBound(arrItems)                                 'From i+1th element to last element
            If arrItems(i).id < arrItems(j).id Then                  'Sorting in DESCENDING ORDER by the Property "ID"
                tempObj.ID = arrItems(i).ID
                tempObj.TestText = arrItems(i).testText
                dict.item(arrKeys(i)).ID = arrItems(j).ID
                dict.item(arrKeys(i)).TestText = arrItems(j).TestText
                dict.item(arrKeys(j)).ID = tempObj.ID
                dict.item(arrKeys(j)).TestText = tempObj.TestText
            End If
        Next
    Next
    Set SortDict = dict
End Function

Before Sorting:

|Key             |Value                |
|----------------|---------------------|
|1               |1,Test1              |
|2               |2,Test2              |
|3               |3,Test3              |
|4               |4,Test4              |
|5               |5,Test5              |

After Sorting:

|Key             |Value                |
|----------------|---------------------|
|1               |5,Test5              |
|2               |4,Test4              |
|3               |3,Test3              |
|4               |2,Test2              |
|5               |1,Test1              |

I could not find a better way to swap the values. I am sure there is a better way to do that. Will update it once I get something.

Answer 2

If you need to do a single pass along the dictionary you could use a disconnected recordset to sort the keys, then retrieve the values from the dictionary in the order to get the keys from the recordset.

dim rs 'the recordset used to sort keys  must be global
Set D = CreateObject("Scripting.Dictionary") 
for i=1 to 10
d.add right("0000"&Cint(rnd*10000),4), i
next

'
for each j in d.keys
   wscript.echo j & " " & d(j) 
next    
wscript.echo ""

i=0
do
  b= DicNextItem(d,i)
  wscript.echo b(0)&" "&b(1)
loop until i=-1 

'---------------------------------------------

Function DicNextItem(dic,i) 
'returns successive items from dictionary ordered by keys
'arguments  dic: the dictionary
'         i: 0 must be passed at fist call, 
'                 returns 1 if there are more items 
'                 returns-1 if no more items   
'returns array with the key in index 0 and the value and value in index 1
'requires rs as global variable (no static in vbs)  
'it supposes the key is a string
      const advarchar=200
      const adopenstatic=3
      dim a(2)
      if i=0 then
        Set rs = CreateObject("ADODB.RECORDSET")
        with rs 
        .fields.append "Key", adVarChar, 100
        .CursorType = adOpenStatic
        .open
        'add all keys to the disconnected recordset  
        for each i in Dic.keys
          .AddNew
          rs("Key").Value = i
          .Update
        next
        .Sort= " Key ASC"
        .MoveFirst
        end with
        i=1
       end if
       if rs.EOF then 
         a=array(nul,nul)
       else
         a(0)=rs(0)
     a(1)=dic(a(0))
         rs.movenext
       end if
       if rs.EOF then i=-1:set rs=nothing
       DicNextItem=a
end function

Answer 3

To add onto the answers provided by @Potato, I needed to sort by descending two values in a dictionary and compare these values to a database. Luckily the UI allowed me to first sort by descending and then I used the Sorting method provided by @Potato to compare the values to the DB. I would have had to use more dictionaries if I were required to sort more than one value in the DB.

This function takes a dictionary a groups it by similar values such as ID. Then sorts that dictionary by a second value in ReverseSortDescDict(descDict)

Function OrderCompareDictionary(UICompareDict, MIPdict)
arrItems = UICompareDict.Items
arrKeys = UICompareDict.Keys
limitkeys = cint(UBound(arrKeys))
numOfCols = Ubound(arrItems(0))    
Set descDict = CreateObject("Scripting.Dictionary")

For k = 0 To limitkeys    
If Ubound(arrItems(k)) = numOfCols Then
    If not (k < 0 or k > UBound(arrKeys))  Then
        If not (k = UBound(arrKeys)) Then
            If arrItems(k)(0) = arrItems(k + 1)(0) Then 
                descDict.Add arrKeys(k) , arrItems(k)
            Else 
                descDict.Add arrKeys(k) , arrItems(k)  'Does not match next value
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)
            End If
        Else
            If arrItems(k)(0) = arrItems(k - 1)(0) Then 'Last row matches previous row
                descDict.Add arrKeys(k) , arrItems(k)
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)                    
            Else
                descDict.Add arrKeys(k) , arrItems(k)
                Call ReverseSortDescDict(descDict)
                Call CompareAndResetDescDict(descDict, k, MIPdict)                    
            End If
        End If
    Else
        MsgBox "Out of bounds for dictionary array values"
    End If
Else
    MsgBox "Error in comparison"
End If
Next      
End Function

This function sorts by descending before comparing. Included print statements to see dictionary object.

Function ReverseSortDescDict(descDict)

Dim i, j, temp
For Each i In descDict
    For Each j In descDict
        If(descDict.Item(i)(1) >= descDict.Item(j)(1)) Then
            temp = descDict.Item(i)
            descDict.Item(i) = descDict.Item(j)
            descDict.Item(j) = temp
        End If
    Next
Next

displayDescDictCount = 0
descDictKeys = descDict.Keys
descDictItems = descDict.Items
For each item in descDictItems 
    print descDictKeys (displayDescDictCount) & " " & item(0) & " " & item(1) & " " & item(2)
    displayDescDictCount = displayDescDictCount + 1
Next

End Function