Sub t()
Dim sh1 As Worksheet, sh2 As Worksheet, c As Range, fn As Range, fadr As String
Set sh1 = Sheets("Sheet1") 'Edit sheet name
Set sh2 = Sheets("Sheet2") 'Edit sheet name
For Each c In sh1.Range("A2", sh1.Cells(Rows.Count, 1).End(xlUp))
Set fn = sh2.Range("A:A").Find("c.Value", , xlValues, xlWhole)
If Not fn Is Nothing Then
fadr = fn.Address
Do
If fn.Offset(, 3).Value = c.Offset(, 1).Value Then
fn.Offset(, 4) = "Dup"
End If
Set fn = sh2.Range("A:A").FindNext(fn)
Loop While fadr <> fn.Address
End If
Next
End Sub
Bookmarks