VBA For Each Match, copy cell value to another worksheet.

[BenGee]

Hi

Here's what I'm struggling to do;

I have a list in sheet 2, between A2:A20. And another list in sheet 1, A6:A500.

I want to go through each cell in sheet 2, A2:A20 and for each / every match in sheet 1, A6:A500 to then copy the cell value in column J into the next blank column in sheet 2 (on the matching row).

So for example, A2 (sheet2) matches A20 (sheet 1) so will then copy/paste J20 into B2 (sheet2). The next match would then paste the value of column J (sheet1) into C2 (sheet 2) and so on..

Hope I've explained this well and thank you in advance

 

[Fluff]

How about

Sub BenGee()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Sheets("Sheet1").Range("A6:A500")
         If Not .Exists(Cl.Value) Then
            .Add Cl.Value, Cl.Offset(, 9).Value
         Else
            .Item(Cl.Value) = .Item(Cl.Value) & "|" & Cl.Offset(, 9).Value
         End If
      Next Cl
      For Each Cl In Sheets("Sheet2").Range("A2:A20")
         If .Exists(Cl.Value) Then
            Cl.Offset(, 1).Resize(, UBound(Split(.Item(Cl.Value), "|")) + 1) = Split(.Item(Cl.Value), "|")
         End If
      Next Cl
   End With
End Sub

 

[BenGee]

This was perfect, thank you

 

[Fluff]

You're welcome & thanks for the feedback