3

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

ZAR
  • 2,550
  • 4
  • 36
  • 66

3 Answers3

5

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
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
3

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
David Zemens
  • 53,033
  • 11
  • 81
  • 130
  • That's a good idea - making it an easily split-able string. The Split function will return the string as an array, as I've just read. Thanks David! – ZAR Oct 15 '14 at 19:59
  • 2
    Although Tim's answer ultimately answered this question, I thought your idea of putting it in a string at first and then splitting later was clever. Unfortunately, since I'm working with over 200k rows, the extra loop to split the strings is causing excel to hang! I am slightly surprised by this since his solution requires creating a new array and redimensioning pretty often mid loop, but the solution is surprisingly quick. hmmm... – ZAR Oct 15 '14 at 20:12
  • 1
    I didn't test on any data nearly that large. Still that is odd... because the first loop will always iterate once for each row, (and especially in the case of Tim's answer I've always understood that `ReDim Preserve` is an expensive operation and should generally be avoided *within* Loops, if possible) whereas the second loop only iterates for each `Key` in the Dictionary, which should be smaller. Perhaps the `Split` function is expensive in terms of memory use, though... – David Zemens Oct 16 '14 at 01:34
1

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
Alter
  • 3,332
  • 4
  • 31
  • 56
  • You make a good point about not using rows.count. I imagine this is solved in Tim;s answer with "UsedRange.Rows.Count"? – ZAR Oct 15 '14 at 20:15
  • yes, that is a good solution. I think it was him who pointed out to me that UsedRange will include empty cells if they have been formatted. It's funny we're using the opposite methods this time – Alter Oct 15 '14 at 20:20
  • 1
    Just a consideration, but I think that David Zemens had a good idea to use a string rather than an array. If you ever want to get the array back just use the split(names, ", "). It seems like a lot more work to redim the array (whoops, you already pointed that out) – Alter Oct 15 '14 at 20:26
  • 1
    A second note is that you don't need to split the strings until right before you use them (no need to create a new loop to split them) – Alter Oct 15 '14 at 20:28