**finding duplicates from multiple columns and highlighting**

[kyle.macdonald]

I have a list consisting of 2 columns that a duplicate may appear in 1 column
but if the second column has a different value it is still unique. I wish to
check this list against a second master list (containing all the info) and
find the duplicates in the first list and copy these duplicates to a second
sheet in the same document. Lists contain both numbers and letters. List is
over 10,000 rows so need to have no manual part to this.

Thanks

Kyle

 

[joel]

I do this all the time. I like using a formula on the worksheet using
SumProdcut to find the duplicates. The use autofilter to to get just
the duplicates. then using specialcell method copy only the visible
cells to a new sheet.

Sub CopyDuplicates()

Set Sourcesht = Sheets("sheet1")
Set DestSht = Sheets("sheet3")
Set MasterSht = Sheets("Master")

With MasterSht
MasterRows = .Range("A" & Rows.Count).End(xlUp).Row
End With


With Sourcesht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'create formula that will put an X in column IV if a duplicate
occurs
Range("IV1").Formula = _
"=if(Sumproduct(--(A1=" & MasterSht.Name & "!A$1:A$" & MasterRows
& ")," & _
"--(B1=" & MasterSht.Name & "!B$1:B$" & MasterRows &
"))>0,true,false)"
'copy formula down column
Range("IV1").Copy _
Destination:=.Range("IV1:IV" & LastRow)

'use autofilter to find the duplicates indicated by true
Columns("IV:IV").AutoFilter
Columns("IV:IV").AutoFilter Field:=1, Criteria1:="TRUE"

'use special cells to find visible cells
Rows("2:" & LastRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=DestSht.Rows(1)
End With

End Sub

 

[vavasoo]

Sub CheckingForDuplicates()

'i have done it for 5 rows only. Change it to 10000

'assuming your lists are in Columns A & B and starting in the first row

Cells(1, 3).FormulaR1C1 = "=rc[-2]&rc[-1]"
Cells(1, 4) = 1
Cells(2, 4).FormulaR1C1 = "=r[-1]c+1"
Cells(1, 3).Copy Range("c2:C5")
Cells(2, 4).Copy Range("d3:d5")
Range("c1:c5").Value = Range("c1:c5").Value
With Sheets(1).Sort
..SetRange Range("c1:c5")
..Apply
End With

'this section lists the duplicates in sheet 2

Dim Rows As Integer
Dim SheetsTwoRows As Integer
SheetsTwoRows = 1
For Rows = 2 To 5
If Cells(Rows + 1, 3).Value = Cells(Rows, 3) Then
Sheets(2).Cells(SheetsTwoRows, 1) = Cells(Rows, 3)
Sheets(2).Cells(SheetsTwoRows, 2) = Cells(Rows, 4)
SheetsTwoRows = SheetsTwoRows + 1
End If
Next

End Sub