Sorting a dictionary by key in VBA

Question

I have created a dictionary in VBA using CreateObject("Scripting.Dictionary") that maps source words to target words to be replaced in some text (This is actually for obfuscation).

Unfortunately, when I do the actual replace as per the code below, it will replace the source words in the order they were added to the dictionary. If I then have for instance "Blue" and then "Blue Berry", the "Blue" part in "Blue Berry" is replaced by the first target and " Berry" remains as it was.

'This is where I replace the values
For Each curKey In dctRepl.keys()
    largeTxt = Replace(largeTxt, curKey, dctRepl(curKey))
Next

I'm thinking that I could resolve this issue by first sorting the dictionary's keys from longest length to shortest length and then doing the replace as above. The problem is I don't know how to sort the keys this way.

See [cpearson.com](http://www.cpearson.com/excel/CollectionsAndDictionaries.htm) — chris neilsen, Feb 11 '13 at 08:40
@chrisneilsen: Nice link although not exactly what I needed. — neelsg, Feb 11 '13 at 08:44

score 16 · Accepted Answer · edited Feb 25 '19 at 08:39

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

@ashleedawg Thanks for the link. It is always nice to see that others have adapted my code. This is what SO is all about and we all are just building upon the vast work of those who came before us — neelsg, Sep 26 '18 at 09:07
Agreed+ ... I wish there was a "Stack Overflow" back when I started learning. *Back in the day* there was pretty much only expertsexchange ... long before they added the hyphen to put an end to the running jokes about their name. — ashleedawg, Sep 26 '18 at 09:35
may I allow myself to adapt your code. you can get rid of one loops by writing: arrTemp = dicList.Keys — Oleksandr Krasnoshchok, Mar 17 '21 at 13:58

mvanle · Answer 2 · 2014-12-15T04:42:55.937

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

Would be much easier to read with full clean code instead of commented "Diff" — Askolein, Feb 19 '16 at 09:06

score 2 · Answer 3 · answered Jul 03 '20 at 22:14

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

Not sure if this is still relevant, but I found the following post, Use System.Collections.ArrayList in VBA - what .NET Framework version is needed? at https://stackoverflow.com/questions/58776731/use-system-collections-arraylist-in-vba-what-net-framework-version-is-needed. The gist of the thread is that regardless of the .Net Framework you have installed, you MUST have .Net Framework 3.5 installed to use an ArrayList within Excel VBA. — j2associates, Jul 23 '21 at 16:17
Here is another one. Disclaimer, this may be dated material as it refers to .Net Framework 2.0. I don't do a lot of VBA anymore, so have no easy way to test this. How to call .NET methods from Excel VBA? at https://stackoverflow.com/questions/37074533/how-to-call-net-methods-from-excel-vba?rq=1 — j2associates, Jul 23 '21 at 16:27

j2associates · Answer 4 · 2020-06-20T12:24:50.693

I know this is an old thread but it was helpful when I encountered a similar issue. My solution was to use a Sandbox worksheet and let Excel sort the keys and then just rebuild the dictionary. By using a Sandbox worksheet, you can very easily use formulas for otherwise difficult sorting situations without having to write your own bubble sort on the keys. In the case of the original poster, sorting descending on Len(Key) would have solved the problem.

Here is my code:

Private Sub SortDictionary(oDictionary As Scripting.Dictionary, oSandboxSheet As Worksheet)
On Error Resume Next
Dim oSortRange As Range
Dim oNewDictionary As Scripting.Dictionary
Dim lBegRow As Long, lEndRow As Long, lBegCol As Long, lEndCol As Long
Dim lIndex As Long
Dim sKey As String
Dim vKeys As Variant

    ' Transpose Keys into ones based array.
    vKeys = oDictionary.Keys
    vKeys = Application.WorksheetFunction.Transpose(vKeys)

    ' Calculate sheet rows and columns based upon array dimensions.
    lBegRow = LBound(vKeys, 1): lEndRow = UBound(vKeys, 1)
    lBegCol = LBound(vKeys, 2): lEndCol = UBound(vKeys, 2)

    With oSandboxSheet
        .Activate
        .Cells.EntireColumn.Clear

        ' Copy the keys to Excel Range calculated from Keys array dimensions.
        .Range(.Cells(lBegRow, lBegCol), .Cells(lEndRow, lEndCol)).Value = vKeys
        .Cells.EntireColumn.AutoFit
    
        ' Sort the entire range.
        Set oSortRange = .Range(.Cells(lBegRow, lBegCol), .Cells(lEndRow, lEndCol))
        With .Sort
            With .SortFields
                .Clear
                Call .Add(Key:=oSortRange, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal)
            End With
        
            Call .SetRange(oSortRange)
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    
        ' Recreate the keys now sorted as desired.
        vKeys = .Range(.Cells(lBegRow, lBegCol), .Cells(lEndRow, lEndCol)).Value
    End With

    ' Create a new dictionary with the same characteristics as the old dictionary.
    Set oNewDictionary = New Scripting.Dictionary
    oNewDictionary.CompareMode = oDictionary.CompareMode

    ' Iterate over the new sorted keys and transfer values from old dictionary to new dictionary.
    For lIndex = LBound(vKeys, 1) To UBound(vKeys, 1)
        sKey = vKeys(lIndex, 1)
        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 oSortRange = Nothing
On Error GoTo 0
End Sub

score 1 · Answer 5 · answered Oct 02 '21 at 18:14

Keys can be sorted by adding codes inside the procedure without creating a function.

Dim sdkey,tamp As Variant
With CreateObject("Scripting.Dictionary")
sdkey = .keys
For i = LBound(sdkey) + 1 To UBound(sdkey)    ' We've listed the unique values as alphabetically.
For j = LBound(sdkey) To UBound(sdkey) - 1
If sdkey(j) > sdkey(i) Then
tamp = sdkey(j)
sdkey(j) = sdkey(i)
sdkey(i) = tamp
End If
Next j
Next i

ReDim tamp(1 To UBound(sd_key) + 1, 1 To 2)
…

Sample file source : Get sum of distinct values in Excel

Sorting a dictionary by key in VBA

5 Answers5

Linked