Copy cells if value in other cell matches with cell in another sheet

Kristina96

New Member
Joined
Sep 30, 2019
Messages
33
Hi there,

I need a macro that does the following:
In Sheet 2 column E there are ID numbers. The macro should look for those IDs in Sheet 1, column E.
When found it should copy values in the row of the ID from sheet 1 to sheet 2.
The values are in column C and D in sheet 1 and are supposed to be copied to columns B and C respectively.
Any help is very much appreciated.

Thank you and best regards
Kristina
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
How about
Code:
Sub Kristina96()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("Sheet1")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("E2", Ws1.Range("E" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, -2).Resize(, 2).Value
      Next Cl
      For Each Cl In Ws2.Range("E2", Ws2.Range("E" & Rows.Count).End(xlUp))
         If .exists(Cl.Value) Then Cl.Offset(, -3).Resize(, 2).Value = .Item(Cl.Value)
      Next Cl
   End With
End Sub
 
Upvote 0
Thank you for the reply. The code is only copying the heading of the column though. Not the values.
I don't know if it is important but the ID numbers on sheet 1 start in B3 and the IDs in sheet 2 start in E5.
 
Upvote 0
In you op you said they were both in col E. do you still want to copy cols C:D to cols B:C?
 
Upvote 0
Sorry, I had a typo in the OP.
So, I am trying to look at the values in column B of sheet 1. If column E of sheet 2 already contains that value, no action is required. If not, the value from column B, sheet 1 has to be copoied to column E of sheet 2. Additionally to copying the value itself. The text in colum C and D on sheet 1 should also be copied to column B and C on sheet 2.
Thank you very much and sorry for the confusion!
 
Upvote 0
Ok, how about
Code:
Sub Kristina96()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   
   Set Ws1 = Sheets("sheet1")
   Set Ws2 = Sheets("sheet2")
   With CreateObject("scripting.dictionary")
      For Each Cl In Ws1.Range("B2", Ws1.Range("B" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = Cl.Offset(, 1).Resize(, 2).Value
      Next Cl
      For Each Cl In Ws2.Range("E2", Ws2.Range("E" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then .Remove Cl.Value
      Next Cl
      Ws2.Range("E" & Rows.Count).End(xlUp).Offset(1, -3).Resize(.Count, 2).Value = Application.Index(.Items, 0, 0)
      Ws2.Range("E" & Rows.Count).End(xlUp).Offset(1).Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,507
Messages
6,114,029
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top