CODEWITHSUNDEEP
arraysexcelvbadictionary
Alex_P
Alex_P

Reputation: 2952

Add items to Array in Dictionary

I have a dictionary and want to add new strings to the items. My idea is to create a list of strings as item for each key.

My code is so far:

Sub AccountEntitlements()

    Dim sh1 As Worksheet
    Dim acc As Worksheet
    Dim arr() As Variant
    Dim d As Variant
    Dim i As Long
    Dim count As Long

    Set sh1 = Sheets("Sheet1")
    Set acc = Sheets("accountsentitlements")
    Set d = CreateObject("Scripting.Dictionary")

    arr = sh1.Range("D:F")

    For i = LBound(arr) To UBound(arr)
        If d.Exists(arr(i, 3)) Then
            ReDim Preserve arr(UBound(arr) + 1) '<- Error line
            d(arr(i, 3)) = Array(arr(i, 1))
        Else
            d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
        End If

    Next i

    For count = 1 To d.count - 1
        acc.Cells(count + 1, "D").Value = UCase(d.Keys()(count))
        acc.Cells(count + 1, "E").Value = d.Items()(count)
    Next count

End Sub

The error message is Run-time error '9': Subscript out of range.

The important code block is

For i = LBound(arr) To UBound(arr)
     If d.Exists(arr(i, 3)) Then
          ReDim Preserve arr(UBound(arr) + 1) '<- Error line
          d(arr(i, 3)) = Array(arr(i, 1))
     Else
          d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
     End If

The key of a dictionary is the user account and the items should be their membership groups. Example:

Key= ABCD , Item= Entitlement1, Entitlement2, etc.

How can the item array be extended and include previous entries?

Upvotes: 0

Views: 512

Answers (2)

Alex_P
Alex_P

Reputation: 2952

Thank you very much for your assistance (@Ron Rosenfeld)!

Below is my final code part.

For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        d(arr(i, 3)) = d.Item(arr(i, 3)) & "," & arr(i, 1)
    Else
        d.Add Key:=arr(i, 3), Item:=arr(i, 1)
    End If
Next i

I was still testing whether I should concatenate the strings with & "," & or with the JOIN() function but decided eventually for the first option.

Regarding my array size, I added a row counter to fit the length of the array. lrow = sh1.Cells(Rows.count, "D").End(xlUp).Row.

Upvotes: 0

Ron Rosenfeld
Ron Rosenfeld

Reputation: 60174

Among other problems:

You can only ReDim the last element of a multi-dimensional array.

Your line 

arr = sh1.Range("D:F")

will create a 1-based 2D array: arr(1 to 1048576, 1 to 4). If you have a database with over 4*10^6 elements, you might want to consider a different tool.

So a valid command might be

Redim Preserve arr(1 to ubound(arr,1), 1 to ubound(arr,2)+1)

But that's not what your doing. To accomplish what you want to do, try something like this:

For i = LBound(arr) To UBound(arr)
    If d.Exists(arr(i, 3)) Then
        X = d(arr(i, 3))
        ReDim Preserve X(UBound(X, 1) + 1)
        X(UBound(X, 1)) = arr(i, 1)
        d(arr(i, 3)) = X
    Else
        d.Add Key:=arr(i, 3), Item:=Array(arr(i, 1))
    End If    
Next i

But why not just use a Dictionary or Collection to hold your list of items. Then you don't have to worry at all about resizing your array.

Upvotes: 1

Related Questions