Snasui Excel Forum

Code: Select all

Sub DataMatch()
    Dim LR As Long, i As Long, ws1 As Worksheet, ws2 As Worksheet
    Dim MatchVal As Long
    Application.ScreenUpdating = False
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    With Sheets("Sheet2")
        LR = ws2.Range("B" & Rows.Count).End(xlUp).Row
        For i = 2 To LR
            If IsNumeric(Application.Match(.Range("B" & i).Value, ws1.Columns("B"), 0)) Then
                MatchVal = Application.Match(.Range("B" & i).Value, ws1.Columns("B"), 0)
                .Range("C" & i).Resize(1, 2).Value = ws1.Range("C" & MatchVal).Resize(1, 2).Value
            End If
        Next i
    End With
End Sub