Copy Value to next empty column in sheet2 if values in sheet1 and sheet2 match

[djsmith97]

Been searching and trying different macros for a couple of days now and haven't got things to work quite like I need them. Any help would be greatly appreciated.

I have two sheets in a workbook

Sheet1:

12345 Blue Red Green Blue-Red-Green
12345 Red Green Blue Red-Green-Blue
23456 Blue Green Red Blue-Green-Red
23456 Green Blue Red Green-Blue-Red

Sheet2:

12345
23456

I'm looking to search for the values from Sheet1 ColumnA in Sheet2 ColumnA, if a match is found I want to copy the value of sheet1 Column E to the next empty cell of the row where the value was found in sheet2. The result I'm looking to achieve on sheet2 is as follows:

12345 Blue-Red-Green Red-Green-Blue
23456 Blue-Green-Red Green-Blue-Red


Thanks in advance for your help

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub macro1()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Pcode")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = .Item(Cl.Value) & Cl.Offset(, 4).Value & "|"
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 1).Value = .Item(Cl.Value)
      Next Cl
   End With
   Ws2.Range("B:B").TextToColumns Ws2.Range("B1"), xlDelimited, , False, False, _
     False, False, False, True, "|"
End Sub

 

[djsmith97]

Hi & welcome to MrExcel
How about

Sub macro1()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Pcode")
   Set Ws2 = Sheets("Sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = .Item(Cl.Value) & Cl.Offset(, 4).Value & "|"
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         Cl.Offset(, 1).Value = .Item(Cl.Value)
      Next Cl
   End With
   Ws2.Range("B:B").TextToColumns Ws2.Range("B1"), xlDelimited, , False, False, _
     False, False, False, True, "|"
End Sub

Thanks for the quick response Fluff, this macro works great.

 

[Fluff]

Glad to help & thanks for the feedback