excelvbadictionarynested-lists

Sort a dictionary by a nested dictionary's items

I have sample data in Excel:

enter image description here

Trying to get Top-3 elements (names) by Salary and Top-3 elements (names) by Revenue.

In Visual Basic (VBA) I created dictionary with Name as a Key and nested dictionary as Item

Nested dictionary have "Salary", "Revenue" and "Position" as Keys. And corresponding values as Items.

I created Dictionary as follows:

Dim MainDict As New Scripting.Dictionary
Dim NestedDict As Scripting.Dictionary
    
Dim rngRange As Range
Set rngRange = wsMainWorkSheet.Range("B2:E8")

Dim rowCounter As Long
  
For rowCounter = 1 To rngRange.Rows.Count
    Set NestedDict = New Dictionary
    NestedDict.Add key:="Salary", Item:=rngRange(rowCounter, 2)
    NestedDict.Add key:="Revenue", Item:=rngRange(rowCounter, 3)
    NestedDict.Add key:="Position", Item:=rngRange(rowCounter, 4)
    
    Dim mainKey As String
    mainKey = CStr(rngRange(rowCounter, 1))
    If MainDict.Exists(mainKey) = False Then
        MainDict.Add key:=mainKey, Item:=NestedDict
    Else:
        MainDict.Item(mainKey)("Salary") = MainDict.Item(mainKey)("Salary") + rngRange(rowCounter, 2)
        MainDict.Item(mainKey)("Revenue") = MainDict.Item(mainKey)("Salary") + rngRange(rowCounter, 3)
    End If
Next rowCounter

Now If I print Key, Items in the Dictionary by the code:

Sub PrintDictionary(dict As Dictionary)
Dim key As Variant, subKey As Variant

For Each key In dict.Keys
    Debug.Print vbNewLine; "Name: " & key
    For Each subKey In dict(key).Keys
        Debug.Print subKey & ": " & dict(key)(subKey)
    Next subKey
Next key
End Sub

Result:

Name: Name1 Salary: 400 Revenue: 5000 Position: Manager

Name: Name2 Salary: 500 Revenue: 25000 Position: Associate

(first 2 shown only)

But I can't figure out the following:

Is it possible to do sorting main dictionary based on nested dictionary's items in VBA without presorting data in the Excel table itself? Is it possible to sort data in such structures for further use later?

Book1.xlsm (sample data) is available on DropBox: Book1.xlsm

Solution 
  • Option Explicit

Sub ADO_TOP()
    Dim sSrcFile As String
    Dim sSrcSht As String
    Dim oRSCon As Object, sRSData As Object, sDBCon As String, sSQL As String
    Dim i As Long, sSrcRng As String
    sSrcFile = ThisWorkbook.FullName
    sSrcSht = "Sheet1"
    If Val(Application.Version) < 12 Then
        sDBCon = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
            "Data Source=" & sSrcFile & ";" & _
            "Extended Properties=""Excel 8.0;HDR=YES"";"
    Else
        sDBCon = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
            "Data Source=" & sSrcFile & ";" & _
            "Extended Properties=""Excel 12.0;HDR=YES"";"
    End If
    Set oRSCon = CreateObject("ADODB.Connection")
    Set sRSData = CreateObject("ADODB.Recordset")
    ' Modify top-left cell ref of table as needed
    sSrcRng = sSrcSht & "$" & Sheets(sSrcSht).Range("B1").CurrentRegion.Address(0, 0)
    oRSCon.Open sDBCon
    sSQL = "SELECT TOP 3 * FROM (SELECT Name,Sum(Salary) as Salary, " & _
        "Sum(Revenue) as Revenue FROM [" & sSrcRng & "] GROUP BY Name) ORDER BY Salary DESC "
    sRSData.Open sSQL, oRSCon, 0, 1, 1
    ' Write the output data to newsheet
    ' TOP 3 Salray
    Sheets.Add
    Range("A1") = "TOP 3 Salray"
    For i = 0 To sRSData.Fields.Count - 1
        Cells(3, i + 1).Value = sRSData.Fields(i).Name
    Next i
    Range("A4").CopyFromRecordset sRSData
    
    sRSData.Close: Set sRSData = Nothing
    oRSCon.Close: Set oRSCon = Nothing
End Sub


        sSQL = "SELECT TOP 3 * FROM (SELECT Name,Sum(Salary) as Salary, " & _
        "Sum(Revenue) as Revenue FROM [" & sSrcRng & "] GROUP BY Name) ORDER BY Revenue DESC "

    enter image description here