Creating list of duplicates

[Pawan]

Hello...

I have a worksheet with thousands of row and several columns. There are
three important columns , say A, B and C. If data in these three columns is
repeated (duplicated), then I have to sort these rows. e.g.

A B C D E
John NY 25 M JK
Lisa NY 29 F JK
John NY 25 M IN

In the above case, Row 1 and 3 has duplicated values in columns A, B and C
(difeerent values in other columns doesnt matter). I have to find out such
'duplicated rows' and I want to generate a list of such rows in a separate
worksheet.
Is it possible? Any help is highly appreciated.

Thank You

Regards,
Pawan

 

[Joel]

You can do this either with a formula or a macro. the easiest way is to
create an auxilary column with the results. Then use Autofilter to get the
rows that match. finally perform a copy and paste. Used this formula in
Colmn E

=IF(SUMPRODUCT(--(A1=A$1:A$1000),--(B1=B$1:B$1000),--(C1=C$1:C$1000))>1,TRUE,FALSE)

Copy formula down the auxilary column

 

[Pawan]

Thanks Joel...

But the main thing is that I want to automate this task and hence need the
macro. The separate worksheet is needed to generate report and it will be
very cumbersome to do this amnually each time!

 

[Joel]

I can't win. Everytime I do this with code at this website somebody else
suggests doing it manually. Finally I decided to show the manual approach
and you want the macro. Change the original sheet name as required on the
following line.
With Sheets("Sheet1")



Sub GetDuplicates()

'Create new worksheet
Set NewSht = Worksheets.Add(after:=Sheets(Sheets.Count))
NewSht.Name = "Duplicates - " & Format(Date, "MM_DD_YY")

With Sheets("Sheet1")
.Cells.Copy Destination:=NewSht.Cells
End With

With NewSht
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
'add formula to last column IV to use for filtering
.Range("IV1").Formula = "=IF(SUMPRODUCT(--(A1=A$1:A$1000)," & _
"--(B1=B$1:B$1000),--(C1=C$1:C$1000))>1,TRUE,FALSE)"
.Range("IV1").Copy Destination:=.Range("IV1:IV" & LastRow)
For RowCount = LastRow To 1 Step -1
If .Range("IV" & RowCount) = False Then
.Rows(RowCount).Delete
End If
Next RowCount
.Columns("IV").Delete
End With
End Sub