Macro help find duplicates in two columns

I need a macro that will search two columns and locate any duplicates between the two columns. Here is an example of my data:

[TABLE="width: 895"]

[tr]

[td]

3051CD2A22A1AS1E5M5CNJ3-1199WDAB3AFFW71DC00

[/td]

[td]

3051SFPDS010W3M0800D31AA1A2KDM5C5

[/td]

[/tr]

[tr]

[td]

3051CG4A04A1AH3E5CN

[/td]

[td]

475HP1EKLUGMT

[/td]

[/tr]

[tr]

[td]

03031-0313-0013

[/td]

[td]

3051CD2A03A1AH2E5CN

[/td]

[/tr]

[tr]

[td]

475HP1EKLUGMT

[/td]

[td]

3144PD1A1E5M5Q4CNB4

[/td]

[/tr]

[/TABLE]

The first column is column "A". The second column is column "B". In column "C", I want the output to be 475HP1EKLUGMT in the cell 2. The macro needs to run until the last used cell in each column has been checked for duplicates.

Thanks,
J

Re: Macro help find duplicates in two columns

Quote from dangle;605894

J

Does this give you what you need?

Code

Sub Dups()
Dim a, i As Long, x As Long, rCell As Range
a = Sheets("Sheet1").Columns("A").SpecialCells(2, 2)
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 1 To UBound(a, 1)
        If Not .exists(Trim(a(i, 1))) Then
            x = x + 1
            .Item(Trim(a(i, 1))) = x
        End If
    Next
    For Each rCell In Sheets("Sheet1").Columns("B").SpecialCells(2, 2)
        If .exists(Trim(rCell.Value)) Then
            rCell.Offset(, 1) = Trim(rCell.Value)
        End If
    Next
End With
Set rCell = Nothing
End Sub

Display More

This code works for the columns A and B, but what if I want to look for duplicates in column D vs. column A, and then output that in column E?