CODEWITHSUNDEEP
arraysvbaexceldictionarymultidimensional-array
ZAR
ZAR

Reputation: 2736

VBA Dictionary with Dynamic Arrays

I'm trying to create A dynamic dictionary that contains dynamic arrays.

Sample Row from spreadsheet:

Facility Name|Contact Name|Contact Role

The relationship between facilities and contacts are M2M. I would like to recreate a sheet that looks like this:

Contact Name| Facility1 - role, Facility2 - role

What I would like to do is create a dictionary of names with unique names serving as keys

New Dictionary  Names(name)

The values for Names(name) will be an array of all the row numbers where this name appears. For instance, say "Joe Rose" appears in rows 3, 7 and 9:

names("Joe Rose") = [3,7,9]

I know how I could do this in JS, Python, PHP, but VBA is driving me crazy!

Here is what I kind of got so far:

Dim names As Dictionary
Set names = New Dictionary

Dim name

For i=1 To WorkSheets("Sheet1").Rows.Count
  name = WorkSheets("Sheet1").Cells(i,2)
  If Not names(name) Then
    names(name) = i
  Else
    'help!
    'names(name)) push new i, maybe something with redim preserve?
  End If
Next i

Even just pointing me to some article that I could reference would be great! VBA has been so frustrating coming from a PHP background!

Thank you

Upvotes: 3

Views: 6522

Answers (3)

Tim Williams
Tim Williams

Reputation: 166196

It's a bit tricky since you have to pull the array out of the Dictionary to work with it, then put it back:

Sub Tester()

    Dim names As Dictionary
    Set names = New Dictionary

    Dim name, tmp, ub, i, k

    For i = 1 To Worksheets("Sheet1").UsedRange.Rows.Count

        name = Trim(Worksheets("Sheet1").Cells(i, 2).Value)

        If Len(name) > 0 Then
            If Not names.Exists(name) Then
                names(name) = Array(i)
            Else
                tmp = names(name)
                ub = UBound(tmp) + 1
                ReDim Preserve tmp(0 To ub)
                tmp(ub) = i
                names(name) = tmp
            End If
        End If
    Next i

    For Each k In names.Keys
        Debug.Print k, Join(names(k), ",")
    Next k


End Sub

Upvotes: 5

Alter
Alter

Reputation: 3464

Try to avoid using [worksheet].rows.count when looping, its value is more than 1 million for excel 2010.

Public Sub test()
    Dim names As Dictionary
    Dim name
    Dim cell As Object

    'finds last row in column 2
    lastRow = Worksheets("Sheet1").Cells(Rows.Count, 2).End(xlUp).Row
    Set names = New Dictionary

    For Row = 1 To lastRow
        Set cell = Worksheets("Sheet1").Cells(Row, 2)
        name = Split(cell.Text, "|")(0)

        If names.Exists(name) Then
            names(name) = names(name) & ", " & Row
        Else
            names.Add name, Row
        End If
    Next Row
End Sub

Upvotes: 1

David Zemens
David Zemens

Reputation: 53623

Let's do this. First build the dictionary's Value as a comma-delimited string. Then, if you need/want, you can use the SPLIT function to convert that to an array.

Dim names As Dictionary
Set names = New Dictionary

Dim name

For i = 1 To WorkSheets("Sheet1").Rows.Count
  name = WorkSheets("Sheet1").Cells(i,2)

  If names.Exists(name) Then
      names(name) = names(name) & "," & i
  Else
      names(name) = i
  Next

Next i

For each name in names
    names(name) = Split(name, ",")
Next

Upvotes: 3

Related Questions