Solved: Find duplicates on 4 column and copy result on another column

[parscon]

This VBA Code Will Compare A to D and show the duplicates.

Now I want to write the result (duplicates) on column E. you can see the attachmentfor sample.

Thank you very much for your help.


Sub test_MatchCells()
Dim i As Long, cell As Range, rng1 As Range, rng2 As Range

Set rng1 = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Set rng2 = Range(Range("D1"), Range("D" & Rows.Count).End(xlUp))
On Error Resume Next
For Each cell In rng1
i = WorksheetFunction.Match(cell.Value, rng2, 0)
If Err Then
Err.Clear
Else
MsgBox "Found " & cell.Value & " In parcel No and " & cell & " in instrument No @ " & "Row:" & i
End If
Next

End Sub

[CatDaddy]

Sub test_MatchCells()
Dim i As Long, r As Long, cell As Range, rng1 As Range, rng2 As Range

Set rng1 = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Set rng2 = Range(Range("D1"), Range("D" & Rows.Count).End(xlUp))
r = 1
On Error Resume Next
For Each cell In rng1
i = WorksheetFunction.Match(cell.Value, rng2, 0)
If Err Then
Err.Clear
Else
MsgBox "Found " & cell.Value & " In parcel No and " & cell & " in instrument No @ " & "Row:" & i
Range("C" & r).Value = cell.Value
r = r + 1
End If
Next

End Sub

[parscon]

Thank you very much .

[snb]

Alternative:

Sub snb()
sn = Application.Transpose(Filter([transpose(if(iserror(match(A1:A3500,$D$1:$D$7000,0)),"~","found " & A1:A3500 & " in B" & match(A1:A3500,$B$1:$B$7000,0)))], "~", False))

Cells(1, 3).Resize(UBound(sn)) = sn
end sub