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

Improve this question

3 Answers 3

Reset to default
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
Improve this answer
Sign up to request clarification or add additional context in comments.

2 Comments

This is the approach I had wanted to take, but I just haven't gotten used to redefining the size of arrays (I'm just used to "pushing" a value in!)
Yep - no push() in VBA ;-(
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
Improve this answer

3 Comments

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!
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...
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...
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
Improve this answer

4 Comments

You make a good point about not using rows.count. I imagine this is solved in Tim;s answer with "UsedRange.Rows.Count"?
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
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)
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)

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.