VBA Arrays for concatenate?

[twelin]

Hi all,
I have long a list of entities with a unique code, and the countries where they are represented.
I want to discard all "GB" and then list all counties per entity in one row. See example.

I tried out with arrays but couldn't figure it out.

INPUT			Desired Output
ISIN	Country		ISIN	Countries
SE0000900169	GB		SE0000900169	SE
SE0000900169	SE		SE0008103071	NO, SE
SE0008103071	GB		SE0011338441	FI, LU, SE
SE0008103071	NO
SE0008103071	NO
SE0008103071	SE
SE0011338441	FI
SE0011338441	FI
SE0011338441	GB
SE0011338441	LU
SE0011338441	SE

Does anyone have a good idea on how to perform this?

Regards
Tobias

 

[Fluff]

How about

Sub twelin()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
         If Cl.Value <> "GB" Then
            If Not .Exists(Cl.Offset(, -1).Value) Then
               .Add Cl.Offset(, -1).Value, Cl.Value
            Else
               .Item(Cl.Offset(, -1).Value) = .Item(Cl.Offset(, -1).Value) & ", " & Cl.Value
            End If
         End If
      Next Cl
      Range("D2").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
   End With
End Sub

 

[CalcSux78]

If you do not want duplicate countries, modify the Else statement in Fluff's code to this:

ElseIf InStr(1, .Item(Cl.Offset(, -1).Value), Cl.Value, vbTextCompare) = 0 Then
     .Item(Cl.Offset(, -1).Value) = .Item(Cl.Offset(, -1).Value) & ", " & Cl.Value
End If

 

[twelin]

Thank you Fluff for such a speedy help! Fantastic!

Your code works like a charm, however CalcSux78's was right about the duplicates. When I followed his suggestion I get an error code:

Sub twelin()
Dim Cl As Range

With CreateObject("scripting.dictionary")
For Each Cl In Range("B2", Range("B" & Rows.Count).End(xlUp))
If Cl.Value <> "GB" Then
If Not .Exists(Cl.Offset(, -1).Value) Then
.Add Cl.Offset(, -1).Value, Cl.Value
ElseIf InStr(1, .Item(C1.Offset(, -1).Value), C1.Value, vbTextCompare) = 0 Then
.Item(C1.Offset(, -1).Value) = .Item(C1.Offset(, -1).Value) & ", " & C1.Value
End If
Next Cl 'Compile error: Next without For
Range("D2").Resize(.Count, 2).Value = Application.Transpose(Array(.Keys, .Items))
End With
End Sub

How can that be? There is obviously a "For Each..." 7 rows up?

 

[Fluff]

You're missing an End If, before the Next Cl

 

[twelin]

Many thanks! Problem solved.

 

[Fluff]

Glad we could help & thanks for the feedback