How to access keys of nested Dictionary?

Question

I have some data that I'm trying to store in a nested dictionary.

I would then like to be able to iterate through this nested dictionary and output the data somehow. (Ultimately, in cells, but for now I'm just trying to get the "most nested" keys).

The data is set up like this:

Recipient   Company InfoA   InfoB   InfoC   InfoD
John        CompanyA          123       
Jacob       CompanyB    322           44    
Smithy      CompanyC                
Smitherson  CompanyD     11    22            555

The idea is to loop through each row with data, and if there's numbers in the "Info[]" column, store that according to the Info/Company, then Receipient.

Here's a "visual" of how I want the info stored:

John            
    CompanyA        
        InfoB   123
Jacob           
    CompanyB        
        InfoA   322
        InfoC   44
Smitherson          
    CompanyD        
        InfoA   11
        InfoB   22
        InfoD   555

Now, using a traversedictionary() sub I found on SE, I was able to successfully loop through the keys and get to the data - however, and this is my question, I can't seem to get the "Info" portion of the final data.

Here's the VBA to build the dict:

Sub create_dicts()
Dim final As Dictionary
Dim mini As Dictionary
Dim tmp As Dictionary

Dim dataRng As Range, cel As Range, iRow As Range
Set dataRng = Range("C2:F5")

Set final = New Dictionary

For Each iRow In dataRng.Rows
    Set mini = New Dictionary
    If WorksheetFunction.Sum(iRow) <> 0 Then
        Set tmp = New Dictionary
        For Each cel In iRow.Cells
            If cel.Value <> 0 Then
                ' Add that cell's number to a dictionary, with the Header as Key
                tmp.Add Cells(1, cel.Column), cel.Value
            End If
        Next cel
        ' Now that we've checked all cells in that row, add the resulting info to a dict for that Company
        mini.Add Cells(iRow.Row, 2), tmp
        ' Now that we have all info for that row/company, put in a dictionary
        ' with the RECIPIENT as the key
        final.Add Cells(iRow.Row, 1), mini
    End If
Next iRow
TraverseDictionary final
End Sub

How I'm iterating through it:

Private Sub TraverseDictionary(d As Dictionary)
Dim key As Variant
Dim depth As Long
Dim i As Long
'https://codereview.stackexchange.com/questions/63353/
    For Each key In d.Keys
        If VarType(d(key)) = 9 Then
            Debug.Print "KEY: " & key
            depth = depth + 1
            TraverseDictionary d(key)
        Else
            Debug.Print "ITEM: " & d(key)
        End If
        i = i + 1
    Next
End Sub

Output:

KEY: John
KEY: CompanyA
ITEM: 123
KEY: Jacob
KEY: CompanyB
ITEM: 322
ITEM: 44
KEY: Smitherson
KEY: CompanyD
ITEM: 11
ITEM: 22
ITEM: 555

I was expecting:

KEY: John
KEY: CompanyA
KEY: InfoB
ITEM: 123
...

So, as you can see, I can get the Recipient, then Company, but can't get the "Info" part to show. What am I missing/overlooking?

Answer 1

Try this traversal instead:

Private Sub TraverseDictionary(d As Dictionary, Optional ByVal depth As Long = 1)
Dim key As Variant
Dim i As Long

    For Each key In d.Keys
        If VarType(d(key)) = vbObject Then
            Debug.Print String(depth * 3, "-") & "KEY: " & key & " (dictionary)"
            TraverseDictionary d(key), depth + 1
        Else
            Debug.Print String(depth * 3, "-") & "ITEM: " & key & ": " & d(key)
        End If
        i = i + 1
    Next
End Sub

Output:

---KEY: John
------KEY: CompanyA
---------ITEM: InfoB: 123
---KEY: Jacob
------KEY: CompanyB
---------ITEM: InfoA: 322
---------ITEM: InfoC: 44
---KEY: Smitherson
------KEY: CompanyD
---------ITEM: InfoA: 11
---------ITEM: InfoB: 22
---------ITEM: InfoD: 555