Remove duplicates and match two columns

[arjun0405]

Hi ppl,

I need to convert the Table 1 to Table 2 as shown below. Is it possible?

Table 1:

Country	Product
France	A
France	B
France	C
Germany	B
Germany	C
USA	A
USA	A

<tbody>
</tbody>

Table 2:

Country	Product
France	A, B, C
Germany	B, C
USA	A, A

<tbody>
</tbody>

Thanks in advance

Regards
Arjun

 

[Fluff]

Hi & welcome to the board.
How about

Sub CombineProduct()
   Dim Dic As Object
   Dim Cl As Range
   Dim Ky As Variant
   
   Set Dic = CreateObject("scripting.dictionary")
   For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
      If Not Dic.exists(Cl.Value) Then
         Dic.Add Cl.Value, Cl.Offset(, 1).Value
      Else
         Dic.Item(Cl.Value) = Dic.Item(Cl.Value) & ", " & Cl.Offset(, 1).Value
      End If
   Next Cl
   For Each Ky In Dic.keys
      With Sheets("sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1)
         .Value = Ky
         .Offset(, 1).Value = Dic(Ky)
      End With
   Next Ky
End Sub

 

[arjun0405]

Thanks a lot Fluff

 

[Fluff]

You're welcome