Delete duplicate rows?
Posted by Scott on October 03, 2001 8:28 AM
I have a report that spits out reports with several duplicate rows for some reason. Some rows are duplicated as many as 20 times. I would like a macro that would run on what ever the current sheet is at the time and compare every row to the one above it. If every cell in that row is the same as the one above it that row should be deleted.
I found a macro (below) that does this for only the first column, but it doesn't work for my needs. It is possible for any cell to be the same as the one above it (especially the first cell in each row) so it is improtant that the entire row is compared--at least A:AA
Public CurRow, oZ, uY, Qq
Sub DelDups()
Qq = Application.CountA(ActiveSheet.Range("A:A")) 'Get row count before beginning
For uY = 1 To 6 'Spin thru 6 times to get them all
For oZ = 2 To Qq 'Main loop
If Cells(oZ, 1) = Cells(oZ - 1, 1) Then 'Check for dups
Cells(oZ, 1).Select 'Select the cell
Selection.Delete Shift:=xlUp 'Delete
Qq = Qq - 1 'Change loop criteria because cell gone
End If 'End
Next 'Inside loop
Next 'Outside loop
End Sub
Posted by Juan Pablo on October 03, 2001 8:32 AM
Try...
Where it says
Selection.Delete Shift:=xlUp 'Delete
Put
Selection.EntireRow.Delete Shift:=xlUp 'Delete
Juan Pablo
Posted by Scott on October 03, 2001 8:54 AM
Re: Try...
Well...
It deletes more but still isn't quite right. I also need it to compare the entire row so it only deletes true duplicates. This is a sample from a sheet:
Plant Product Group No Material Id Act SGO Cases Act SGO LBS
308 130150 00512240000 1360.000 6446.4
308 130150 00512240000 1360.000 6446.4
The first 2 rows are duplicates but it is very possible for any single cell to be the same as the one above it.
Posted by Juan Pablo on October 03, 2001 9:01 AM
Re: Try...
Try this, it's not VB but i think it works just as fine (And easier)
Suppose your range is in A2:E2000. Put this in F2:F2000 and filter > 1
=SUMPRODUCT(($A$2:A2=A2)*($B$2:B2=B2))*($C$2:C2=C2)*($D$2:D2=D2)*($E$2:E2=E2))
Those who result > 1 are TRUE duplicates.
Juan Pablo
Posted by Anon on October 03, 2001 4:05 PM
Re: Try...
Juan Pablo's suggestion to use a worksheet formula instead of the clumsy and inefficient loop in your macro is a good one.
To use this approach in a macro, try the following(assumes that your data covers columns A:E and that the last row with data always has data in column A of that row) :-
Dim rng As Range
Application.ScreenUpdating = False
Columns(1).Insert
Set rng = Range([B2], [B65536].End(xlUp)).Offset(0, -1)
With rng
.FormulaR1C1 = "=IF(SUMPRODUCT((R2C2:RC[1]=RC[1])*(R2C3:RC[2]=RC[2])*(R2C4:RC[3]=RC[3])*(R2C5:RC[4]=RC[4])*(R2C6:RC[5]=RC[5]))>1,"""",1)"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
On Error GoTo 0
.Delete
End With
To revise the formula in the macro to cover different columns than those assumed (viz. A:E), use the macro recorder to find out the code for the revised formula.
: The first 2 rows are duplicates but it is very possible for any single cell to be the same as the one above it. :
Posted by Amanda on October 04, 2001 4:35 AM
I would use the Advance Filter. You may have to go back and delete/hide your previous range but it seems to work.
Range("RANGE").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=Range("NEWRANGE"), _
Unique:=True
