Sort Dictionary by Numerical Key

Question

I have a dictionary with integer keys and integer items, and just need to sort the dictionary based on the key, but all examples I've found work only for string keys.

Answer 1

edited to add a solution to output X and Y arrays

you could use SortedList object and build a helper sub like follows:

Sub SortDictionary(dict As Object)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        dict.RemoveAll
        For i = 0 To .Keys.Count - 1
            dict.Add .GetKey(i), .Item(.GetKey(i))
        Next
    End With
End Sub

to be exploited as follows:

SortDictionary dict '<--| give 'SortDictionary()' sub a dictionary object to sort by its keys

for instance here's a test:

Sub main()

    Dim dict As Object
    Dim key As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add 5, 15
        .Add 4, 14
        .Add 3, 13
        .Add 2, 12
        .Add 1, 11
    End With

    SortDictionary dict

    With dict
        For Each key In .Keys
            Debug.Print key, .Item(key)
        Next
    End With
End Sub

---

what above can be easily twicked to return X and Y arrays out of dictionary keys and items, as follows:

Sub SortDictionaryToArray(dict As Object, XArray As Variant, YArray As Variant)
    Dim i As Long
    Dim key As Variant

    With CreateObject("System.Collections.SortedList")
        For Each key In dict
            .Add key, dict(key)
        Next
        ReDim XArray(0 To .Count)
        ReDim YArray(0 To .Count)
        For i = 0 To .Keys.Count - 1
            XArray(i) = .GetKey(i)
            YArray(i) = .Item(.GetKey(i))
        Next
    End With
End Sub

to be exploited in your main sub as follows:

SortDictionaryToArray dict, Xs, Ys

as you can see in this complete test:

Sub main()

    Dim dict As Object
    Dim i As Long
    Dim Xs As Variant, Ys As Variant

    Set dict = CreateObject("Scripting.Dictionary")
    With dict
        .Add 5, 15
        .Add 4, 14
        .Add 3, 13
        .Add 2, 12
        .Add 1, 11
    End With

    SortDictionaryToArray dict, Xs, Ys

    For i = 0 To UBound(Xs)
        Debug.Print Xs(i), Ys(i)
    Next
End Sub

Answer 2

Grab the keys as an array, sort that array, then use the sorted array to pull the values from the dictionary.

Sub Tester()

    Dim d As Object
    Dim i As Long, arr, k

    Set d = CreateObject("scripting.dictionary")


    With d
        .Add 3, 33
        .Add 1, 33
        .Add 2, 55
        .Add 5, 77
    End With

    arr = d.keys  '<< get keys in an array

    ' "sort" through the array, and get the values from the dictionary
    Debug.Print "key", "value"
    For i = 0 To UBound(arr)
        k = Application.Small(arr, i + 1)
        Debug.Print k, d(k)
    Next i

End Sub

Output:

  key          value
  1             33   
  2             55   
  3             33   
  5             77

Answer 3

• get the keys and items into a dictionary, overwriting the items to maintain unique keys
• copy the keys to a 1-D array
• sort the 1-D array
• reuse one of the temporary variants as a 2-D array
• put the sorted 'keys' into the 2-D array and use the 'keys' to call the associated item from the original dictionary to the second rank.

Code:

Option Explicit

Sub sortedDictionary()
    Dim i As Long, j As Long, d As Long, dict As Object
    Dim vKEYs As Variant, tmp As Variant

    Set dict = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet4")
        For d = 2 To .Cells(.Rows.Count, "B").End(xlUp).Row
            dict.Item(.Cells(d, "A").Value2) = .Cells(d, "B").Value2
        Next d

        vKEYs = dict.keys

        For i = LBound(vKEYs) + 1 To UBound(vKEYs)
            For j = LBound(vKEYs) To UBound(vKEYs) - 1
                If vKEYs(j) > vKEYs(i) Then
                    tmp = vKEYs(j)
                    vKEYs(j) = vKEYs(i)
                    vKEYs(i) = tmp
                End If
            Next j
        Next i

        ReDim tmp(1 To UBound(vKEYs) + 1, 1 To 2)

        For i = LBound(vKEYs) To UBound(vKEYs)
            tmp(i + 1, 1) = vKEYs(i)
            tmp(i + 1, 2) = dict.Item(vKEYs(i))
        Next i

        .Cells(2, "E").Resize(UBound(tmp, 1), UBound(tmp, 2)) = tmp
    End With
End Sub

Results:

Answer 4

Here is a solution based on using the .Net container ArrayList -- which can be used in VBA. It takes much of the hassle out of sorting:

Function DictToSortedArray(D As Object) As Variant
    'returns a 1-based 2-dimensional sorted array
    'sorted by the keys
    Dim A As Variant, i As Long, AL As Object, k As Variant

    Set AL = CreateObject("System.Collections.ArrayList")

    For Each k In D
        AL.Add k
    Next k

    AL.Sort

    ReDim A(1 To AL.Count, 1 To 2)

    For i = 1 To AL.Count
        A(i, 1) = AL(i - 1)
        A(i, 2) = D(AL(i - 1))
    Next i

    DictToSortedArray = A
End Function

A simple test:

Sub test()
    Dim D As Object
    Dim A As Variant
    Dim i As Long

    Set D = CreateObject("Scripting.Dictionary")
    D.Add 5, 8
    D.Add 3, 7
    D.Add 42, 9
    D.Add 1, 7
    D.Add 10, 11

    A = DictToSortedArray(D)
    For i = 1 To 5
        Debug.Print A(i, 1) & ", " & A(i, 2)
    Next i
End Sub

Output:

1, 7
3, 7
5, 8
10, 11
42, 9