How do you loop through multi array using VBA?

Question

I have the below table in Excel (TABLE).

I am trying to cycle through the table and story in an array (CODE).

Then cycle through the array and produce a unique output based on ID (OUTPUT).

I have provided the code I have but am having trouble determine the best way to loop through the array where the ID is the same - ie I want to group array outputs by ID.

TABLE

| ID | Name | Value |
---------------------
| 01 | John | Value |
| 01 | Sam  | Value |
| 02 | Luke | Value |
| 03 | Jack | Value |
| 04 | Rob  | Value |
| 04 | Bob  | Value |

OUTPUT

01 - John, Sam
02 - Luke
03 - Jack
04 - Rob, Bob

CODE

'Store Array
For row = 2 to 6
   MyArray(i,0) = Cells(row,1).value
   MyArray(i,1) = Cells(row,2).value
   MyArray(i,2) = Cells(row,3).calue
next row

'Output Array
For a = Lbound(MyArray) to Ubound(MyArray)
    ???
Next a

I do not know whether I use if/then/else statements or another loop to achieve this?

Gary's Student · Accepted Answer · 2015-04-29 19:50:47Z

2

Say we begin with:

enter image description here

and we want an output as in your post. Running this:

Sub Macro1()

    Range("A2:A22").Copy Range("E1")
    ActiveSheet.Range("$E$1:$E$21").RemoveDuplicates Columns:=1, Header:=xlNo

    For Each r In Range("E1:E22")
        v = r.Value
        If v = "" Then Exit Sub
        For Each rr In Range("A2:A22")
            vv = rr.Value
            If v = vv Then
                If r.Offset(0, 1).Value = "" Then
                    r.Offset(0, 1).Value = rr.Offset(0, 1).Value
                Else
                    r.Offset(0, 1).Value = r.Offset(0, 1).Value & "," & rr.Offset(0, 1).Value
                End If
            End If
        Next rr
    Next r
End Sub

will produce:

enter image description here

answered Apr 29, 2015 at 19:50

Gary's Student

96.9k10 gold badges66 silver badges104 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

L42 · Accepted Answer · 2015-05-03 22:31:45Z

I'll post my version which uses Dictionary.

Sub Test()
    Dim sh As Worksheet: Set sh = Sheets("Sheet1") ' I try to always be explicit

    With sh
        Dim lr As Long, RawArr
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        RawArr = .Range("A2:C" & lr) ' pass to array
    End With

    Dim i As Long, idkey As String, itm As String
    ' Use Dictionary to handle duplicates and concatenate values
    With CreateObject("Scripting.Dictionary")
        For i = LBound(RawArr, 1) To UBound(RawArr, 1)
            idkey = RawArr(i, 1): itm = RawArr(i, 2)
            If Not .Exists(idkey) Then
                .Add idkey, idkey & " - " & itm
            Else
                .Item(idkey) = .Item(idkey) & ", " & itm
            End If
        Next
        ' Return values to worksheet
        ' Use below if you're working on small data set
        ' If not, replace below with a loop - also posted
        sh.Range("E1:E" & .Count) = Application.Transpose(.Items)
    End With
End Sub

Above is pretty straight forward with the output exactly as you described.
At the last part, we used Application.Transpose to transfer the values back to the worksheet.
Take note that it has limitations as to how large it can handle like 65k rows.
As long as your data does not go near that value, then you should be ok.
If however you have a lot of data, then you'll have to use another loop to get the values (like manually transposing your data).

Dim key, fArr, n As Long: n = 1
ReDim fArr(1 To .Count, 1 To 2) ' use a 2D array
For Each key In .Keys
    fArr(n, 1) = .Item(key)
    n = n + 1
Next
sh.Range("E1:E" & .Count) = fArr

Note: I assumed that your ID's are strings (e.g.01) and not numbers formatted as "00". If that is the case, then you'll need to format it first before you use it as idkey like below to get your desired output.

idkey = Format(RawArr(i, 1), "00")

Collectives™ on Stack Overflow

How do you loop through multi array using VBA?

2 Answers 2

Comments

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Related