CODEWITHSUNDEEP
vbaexcel
barciewicz
barciewicz

Reputation: 3773

VBA: adding to collection which is a dictionary value

Is it possible in VBA to have collection as `Scripting.Dictionary' values and then, in a loop, add new values to this collection as specific key is found?

Something like:

Dim test_dict As New Scripting.Dictionary

For Each cell In ActiveSheet.Range("S2:S13")
    test_dict(cell.value).Add (cell.offset(1,0).value)
Next cell

Also, I need to cater for the fact that the keys will be repeating.

For example in Python I can set the dictionary to have list as value and then append to this list on every iteration:

dictionary= defaultdict(list)

for x in range(1,10):
    dictionary[x].append(x + 100)

Upvotes: 1

Views: 2874

Answers (2)

QHarr
QHarr

Reputation: 84465

Like the following?

Option Explicit

Public Sub GetValues()
    Const col_1 = "col1", col_2 = "col2", col_3 = "col3"

    Dim lists As Object: Set lists = CreateObject("Scripting.Dictionary")

    lists.Add col_1, New Collection
    lists.Add col_2, New Collection
    lists.Add col_3, New Collection

    Dim currentCell As Range
    For Each currentCell In ActiveSheet.Range("S2:S13")
        Select Case currentCell.Value
        Case col_1
            lists(col_1).Add currentCell.Offset(, 1).Value
        Case col_2
            lists(col_2).Add currentCell.Offset(, 1).Value
        Case col_3
            lists(col_3).Add currentCell.Offset(, 1).Value
        End Select
    Next

    Dim key As Variant, item As Long

    For Each key In lists
        For item = 1 To lists(key).Count
            Debug.Print lists(key)(item)
        Next
    Next
End Sub

Data:

Data

If you don't know the keys in advance use:

Option Explicit
Public Sub GetValues()
    Dim lists As Object: Set lists = CreateObject("Scripting.Dictionary")
    Dim currentCell As Range
    For Each currentCell In ActiveSheet.Range("S2:S13")
        If Not lists.exists(currentCell.Value) Then lists.Add currentCell.Value, New Collection
        lists(currentCell.Value).Add currentCell.Offset(, 1).Value
    Next

    Dim key As Variant, item As Long
    For Each key In lists
        For item = 1 To lists(key).Count
            Debug.Print lists(key)(item)
        Next
    Next
End Sub

Upvotes: 2

basodre
basodre

Reputation: 5770

I think I understand what you are looking to do. Using a dictionary, you want to map a key to a collection of items. If my understanding is correct, check the below code and see if you can modify it to suit your needs. I ran a test on it, and it seems to work.

Sub LoadThem()
    Dim coll As New Collection
    Dim rng As Range
    Dim cel As Range
    Dim oDict As Object

    Set oDict = CreateObject("Scripting.Dictionary")

    Set rng = Range("A1:A26")

    For Each cel In rng
        If oDict.exists(cel.Value) Then
            oDict(cel.Value).Add cel.Offset(, 1).Value
        Else
            Set coll = New Collection
            coll.Add cel.Offset(, 1).Value
            oDict.Add cel.Value, coll
        End If
    Next cel


    For Each okey In oDict.keys
        Debug.Print okey
        For Each elem In oDict(okey)
            Debug.Print "    " & elem
        Next elem
    Next okey
End Sub

Upvotes: 2

Related Questions