vba can i put a collection inside a scripting.dictionary

Question

I am trying to create a collection and put inside

mydict = my_key:["a", "b", "c"]

and then iterate over.

    For Each V In mydict.keys
        Debug.Print V
        for z in mydict.Item(V)       
            Debug.Print  z
        next z
    Next V

the output should look like my_key a b c

but i having problems and errors, is it posible to store a collection inside a scripting.dictionary?

or is just storing strings such "my_key":"a", "my_key2":"b"?

thanks.

Answer 1

To store a collection in a dictionary you can use a two-step process of first creating the collection and then adding it to the dictionary:

Sub test()
    Dim C As Collection
    Dim D As Object
    Dim v As Variant

    Set D = CreateObject("Scripting.Dictionary")

    Set C = New Collection
    C.Add "a"
    C.Add "b"
    C.Add "c"

    D.Add "key1", C

    Set C = New Collection 'Old collection safely stored in D
    D.Add "key2", C 'Now D("key2") holds a collection
    D("key2").Add "d"
    D("key2").Add "e"

    Debug.Print "Collection for key1:"
    For Each v In D("key1")
        Debug.Print v
    Next v

    Debug.Print "Collection for key2:"
    For Each v In D("key2")
        Debug.Print v
    Next v

End Sub

The code illustrates how you can add recycle the collection variable C to add multiple collections, and how you can add empty collections to the dictionary to be later modified.

Output:

Collection for key1:
a
b
c
Collection for key2:
d
e

Answer 2

Putting a collection inside a dictionary is an intersting problem in VBA. It is even more interesting, when we do not know the number of the keys and the values in advance. Let's imagine that this is our input in Excel:

And the requested output looks like this in the immediate window Ctrl+G:

This is the code, that would deliver it (Run Main):

Public Sub Main()

    Dim teamDictionary As New Dictionary
    fillTeamDictionary teamDictionary

    Dim myKey As Variant
    Dim myVals As Variant

    For Each myKey In teamDictionary
        Debug.Print myKey; ":"
        For Each myVals In teamDictionary(myKey)
            Debug.Print vbTab; myVals
        Next
        Debug.Print "----------------"
    Next

End Sub

Public Sub fillTeamDictionary(teamDictionary As Dictionary)

    Dim myCell As Range
    Dim teamRange As Range

    With tblTeam
        Set teamRange = .Range("A1:A8") 'range could be flexible...
    End With

    Dim myKey As String
    Dim myVal As String

    For Each myCell In teamRange
        myKey = myCell
        myVal = myCell.Offset(ColumnOffset:=1)

        If teamDictionary.Exists(myKey) Then
            teamDictionary(myKey).Add (myVal)
        Else
            Dim newList As Collection
            Set newList = New Collection
            newList.Add (myVal)
            teamDictionary.Add myKey, newList
        End If
    Next myCell

End Sub

The "trick" is to initialize a new Collection for each unique key of the dictionary, every time we need it:

Dim newList As Collection
Set newList = New Collection
newList.Add (myVal)
teamDictionary.Add myKey, newList

Then add to the collection, whenever the key exists:

If teamDictionary.Exists(myKey) Then
    teamDictionary(myKey).Add (myVal)