Multi-dimensional Dictionary class in VBA

Question

This post is half to share a solution and half to ask if there's a better way to do it.

Problem: how to build a multi-dimensional dictionary in VBA.

It seems there are people out there looking for one, but there isn't an obvious neat solution around so I came up with some code, as follows.

Specific case: convert an ADO Recordset into a Dictionary, where several columns comprise the unique key for a row. Adding multiple records to the same Dictionary fails unless you come up with a key that concatenates all the columns that comprise the unique key.

General case: model a tree structure in an object hierarchy where there might not be the same number of branches across every node at the same level in the hierarchy.

The code below solves both problems. Performance untested but the VBA Scripting library's Dictionary class is apparently indexed with a hash table and I've seen very large systems built with it, so I doubt performance will be an issue. Maybe one of the giant brains out there will correct me on this.

Put this into a VBA class called multiDictionary:

Option Explicit

' generic multi-dimensional dictionary class
' each successive higher dimension dictionary is nested within a lower dimension dictionary
Private pDictionary As Dictionary
Private pDimensionKeys() As Variant

Private Const reservedItemName As String = "multiItem"

Public Function add(value As Variant, ParamArray keys() As Variant)
    Dim searchDictionary As Dictionary
    Dim newDictionary As Dictionary
    Dim count As Long
    If pDictionary Is Nothing Then Set pDictionary = New Dictionary
    Set searchDictionary = pDictionary
    For count = LBound(keys) To UBound(keys)
        If keys(count) = reservedItemName Then Err.Raise -1, "multiDictionary.add", "'" & reservedItemName & "' is a reserved key and cannot be used"
        If searchDictionary.Exists(keys(count)) Then
            Set newDictionary = searchDictionary.item(keys(count))
        Else
            Set newDictionary = New Dictionary
            searchDictionary.add key:=keys(count), item:=newDictionary
        End If
        Set searchDictionary = searchDictionary.item(keys(count))
    Next
    ' each node can have only one item, otherwise it has dictionaries as children
    searchDictionary.add item:=value, key:=reservedItemName
End Function

Public Function item(ParamArray keys() As Variant) As Variant
    Dim count As Long
    Dim searchDictionary As Dictionary
    Set searchDictionary = pDictionary
    For count = LBound(keys) To UBound(keys)
        ' un-nest iteratively
        Set searchDictionary = searchDictionary.item(keys(count))
    Next
    ' the item always has the key 'reservedItemName' (by construction)
    If IsObject(searchDictionary.item(reservedItemName)) Then
        Set item = searchDictionary.item(reservedItemName)
    Else
        item = searchDictionary.item(reservedItemName)
    End If
End Function

And test it like this

Sub testMultiDictionary()
    Dim MD As New multiDictionary
    MD.add "Blah123", 1, 2, 3
    MD.add "Blah124", 1, 2, 4
    MD.add "Blah1234", 1, 2, 3, 4
    MD.add "BlahXYZ", "X", "Y", "Z"
    MD.add "BlahXY3", "X", "Y", 3
    Debug.Print MD.item(1, 2, 3)
    Debug.Print MD.item(1, 2, 4)
    Debug.Print MD.item(1, 2, 3, 4)
    Debug.Print MD.item("X", "Y", "Z")
    Debug.Print MD.item("X", "Y", 3)
End Sub