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:
[TABLE="width: 200"]
<tbody>[TR]
[TD]Country[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD]France
[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]France[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]France[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]Germany[/TD]
[TD]B[/TD]
[/TR]
[TR]
[TD]Germany[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]USA[/TD]
[TD]A[/TD]
[/TR]
[TR]
[TD]USA[/TD]
[TD]A[/TD]
[/TR]
</tbody>[/TABLE]

Table 2:
[TABLE="width: 200"]
<tbody>[TR]
[TD]Country[/TD]
[TD]Product[/TD]
[/TR]
[TR]
[TD]France[/TD]
[TD]A, B, C[/TD]
[/TR]
[TR]
[TD]Germany[/TD]
[TD]B, C[/TD]
[/TR]
[TR]
[TD]USA[/TD]
[TD]A, A[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


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