Macro to copy specific cell based on two other cell contents being an exact match

[exopolitixs]

Hi!

Hoping someone can assist (or point me in the right direction) of a Macro that will populate a column in sheet 1 with specific values from a column in sheet 2 based on the contents being an exact match.

My logic for this if content from cell L2 in Sheet 1 appears at all in column G then copy content from column A in the same row into Sheet 1 column A.

Context is I'm matching usernames from Sheet 1 and 2 to copy over specific user IDs.

Hoping someone can assist! I'm pulling my hair out trying to figure this out.

 

[Jamie McMillan]

Hello,

I am guessing that there are other names in Column L. Starting at L2

Also that Column G is in Sheet 2, copying from the A column on sheet 2, to column A on sheet 1

The following code does that.

Sub GetID()
Dim i As Integer
Dim j As Integer
For j = 2 To 13 'starts at L2 ends at L13
For i = 1 To 12 'Looks through column G from row 1 to 12
    Application.ScreenUpdating = False
    If Cells(j, 12).Value = Sheets("Sheet2").Cells(i, 7).Value Then 'you can delete Sheets("Sheet2").  if column G is on sheet 1
    Sheets("Sheet2").Cells(i, 1).Copy 'Copies the sheet 2 A column of the match 
    Sheets("Sheet1").Cells(i, 1).Select 'Pastes it to Sheet 1 column A
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    End If
Next i
Next j
    Application.ScreenUpdating = True
End Sub

The notes in green will help you change things.

Jamie

 

[Fluff]

Another option

Sub exopolitixs()
   Dim Cl As Range
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet2")
      For Each Cl In .Range("G2", .Range("G" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, -6).Value
      Next Cl
   End With
   With Sheets("Sheet1")
      For Each Cl In .Range("L2", .Range("L" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, -11).Value = Dic(Cl.Value)
      Next Cl
   End With
End Sub

 

[exopolitixs]

Another option

Sub exopolitixs()
   Dim Cl As Range
   Dim Dic As Object
  
   Set Dic = CreateObject("scripting.dictionary")
   With Sheets("Sheet2")
      For Each Cl In .Range("G2", .Range("G" & Rows.Count).End(xlUp))
         Dic(Cl.Value) = Cl.Offset(, -6).Value
      Next Cl
   End With
   With Sheets("Sheet1")
      For Each Cl In .Range("L2", .Range("L" & Rows.Count).End(xlUp))
         If Dic.Exists(Cl.Value) Then Cl.Offset(, -11).Value = Dic(Cl.Value)
      Next Cl
   End With
End Sub

This worked perfectly, thank you so much!

 

[Fluff]

Glad we could help & thanks for the feedback.