Snasui Excel Forum

Code: Select all

Sub MatchData()
    Dim w1 As Worksheet, w2 As Worksheet
    Dim d As Range, drng As Range
    Dim e As Range, erng As Range
    Dim b As Boolean
    Application.ScreenUpdating = False
    Set w1 = Sheets("Sheet1")
    Set w2 = Sheets("Sheet2")
    With w1
        Set drng = .Range("b1", .Range("b" & .Rows.Count).End(xlUp))
    End With
    With w2
        Set erng = .Range("b1", .Range("b" & .Rows.Count).End(xlUp))
    End With
    For Each e In erng
        b = False
        For Each d In drng
            If e.Value = d.Value And e.Offset(0, 3).Value = d.Offset(0, 1).Value Then
                e.Offset(0, 4).Value = d.Offset(0, 4).Value
                b = True
            End If
            If b = True Then Exit For
        Next d
    Next e
    Application.ScreenUpdating = True
End Sub