How do you loop through multi array using VBA? - arrays

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?

Answer 1

Say we begin with:
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:

Answer 2

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")