Sorting a dictionary by key in VBA
Another possibility is to use an ArrayList to sort the Dictionary keys and then use the ArrayList values to recreate the Dictionary.
Private Sub SortDictionary(oDictionary As Scripting.Dictionary)
On Error Resume Next
Dim oArrayList As Object
Dim oNewDictionary As Scripting.Dictionary
Dim vKeys As Variant, vKey As Variant
Set oArrayList = CreateObject("System.Collections.ArrayList")
' Transpose Keys into ones based array.
vKeys = oDictionary.Keys
vKeys = Application.WorksheetFunction.Transpose(vKeys)
For Each vKey In vKeys
Call oArrayList.Add(vKey)
Next
oArrayList.Sort
''oArrayList.Reverse
' Create a new dictionary with the same characteristics as the old dictionary.
Set oNewDictionary = New Scripting.Dictionary
oNewDictionary.CompareMode = oDictionary.CompareMode
' Iterate over the array list and transfer values from old dictionary to new dictionary.
For Each vKey In oArrayList
sKey = CStr(vKey)
If oDictionary.Exists(sKey) Then
Call oNewDictionary.Add(sKey, oDictionary.Item(sKey))
End If
Next
' Replace the old dictionary with new sorted dictionary.
Set oDictionary = oNewDictionary
Set oNewDictionary = Nothing: Set oArrayList = Nothing
On Error GoTo 0
End Sub
I was looking for a simple VBA function to sort dictionaries by ascending key value in Microsoft Excel.
I made some minor changes to neelsg's code to suit my purpose (see the following '//
comments for details of changes):
'/* Wrapper (accurate function name) */
Public Function funcSortDictByKeyAscending(dctList As Object) As Object
Set funcSortDictByKeyAscending = funcSortKeysByLengthDesc(dctList)
End Function
'/* neelsg's code (modified) */
Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
'// Dim arrTemp() As String
Dim arrTemp() As Variant
...
...
...
'Do the sort in the array
For itX = 0 To (dctList.Count - 2)
For itY = (itX + 1) To (dctList.Count - 1)
'// If Len(arrTemp(itX)) < Len(arrTemp(itY)) Then
If arrTemp(itX) > arrTemp(itY) Then
...
...
...
'Create the new dictionary
'// Set funcSortKeysByLengthDesc = CreateObject("Scripting.Dictionary")
Set d = CreateObject("Scripting.Dictionary")
For itX = 0 To (dctList.Count - 1)
'// funcSortKeysByLengthDesc.Add arrTemp(itX), dctList(arrTemp(itX))
d(arrTemp(itX)) = dctList(arrTemp(itX))
Next
'// Added:
Set funcSortKeysByLengthDesc = d
Else
Set funcSortKeysByLengthDesc = dctList
End If
End Function
It looks like I figured it out myself. I created the following function that appears to be doing the job:
Public Function funcSortKeysByLengthDesc(dctList As Object) As Object
Dim arrTemp() As String
Dim curKey As Variant
Dim itX As Integer
Dim itY As Integer
'Only sort if more than one item in the dict
If dctList.Count > 1 Then
'Populate the array
ReDim arrTemp(dctList.Count - 1)
itX = 0
For Each curKey In dctList
arrTemp(itX) = curKey
itX = itX + 1
Next
'Do the sort in the array
For itX = 0 To (dctList.Count - 2)
For itY = (itX + 1) To (dctList.Count - 1)
If Len(arrTemp(itX)) < Len(arrTemp(itY)) Then
curKey = arrTemp(itY)
arrTemp(itY) = arrTemp(itX)
arrTemp(itX) = curKey
End If
Next
Next
'Create the new dictionary
Set funcSortKeysByLengthDesc = CreateObject("Scripting.Dictionary")
For itX = 0 To (dctList.Count - 1)
funcSortKeysByLengthDesc.Add arrTemp(itX), dctList(arrTemp(itX))
Next
Else
Set funcSortKeysByLengthDesc = dctList
End If
End Function
For more info on static arrays see: https://excelmacromastery.com/excel-vba-array/#Declaring_an_Array