ExcelBanter - Delete duplicate rows

How about:

Option Explicit
Sub FixDuplicateRows()
Dim RowNdx As Long
Dim iCol As Long
Dim DeleteThisRow As Boolean
Dim rng As Range

For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1

DeleteThisRow = True
For iCol = 1 To 4 'column A to column D
If Cells(RowNdx, iCol).Value = Cells(RowNdx - 1, iCol).Value Then
'do nothing, keep looking for a difference
Else
DeleteThisRow = False
Exit For
End If
Next iCol

If DeleteThisRow = True Then
If rng Is Nothing Then
Set rng = Cells(RowNdx, 1)
Else
Set rng = Union(rng, Cells(RowNdx, 1))
End If
End If
Next RowNdx
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub

Remember that this expects the duplicated rows to be right next to each other.
You'll want to make sure your data is sorted nicely.

Lupe wrote:

Hi,
I have a solution to delete duplicate rows based on the condition of one
cell in a row, but now I have another situation where I have to check if the
entire row is duplicate. I have data from column A thru D. What should I add
to the existing code? Last time Tom Ogilvy helped me with this code. Thanks
in advance.
Lupe

Sub FixDuplicateRows()
Dim RowNdx As Long
Dim ColNum As Integer
Dim rng As Range
ColNum = Selection(1).Column
For RowNdx = Selection(Selection.Cells.Count).Row To _
Selection(1).Row + 1 Step -1
If Cells(RowNdx, ColNum).Value = Cells(RowNdx - 1, ColNum).Value Then
If rng Is Nothing Then
Set rng = Cells(RowNdx, ColNum)
Else
Set rng = Union(rng, Cells(RowNdx, ColNum))
End If
End If
Next RowNdx
If Not rng Is Nothing Then
rng.EntireRow.Delete
End If
End Sub

--

Dave Peterson