Not as eloquent as some others, but this should get the job done:
Sub DeleteDuplicateRows()
'
' This macro deletes duplicate rows in the selection. Duplicates are
' counted in the COLUMN of the active cell.
Dim Col As Integer
Dim r As Long
Dim C As Range
Dim n As Long
Dim v As Variant
Dim rng As Range
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Col = ActiveCell.Column
If Selection.Rows.count > 1 Then
Set rng = Selection
Else
Set rng = ActiveSheet.UsedRange.Rows
End If
n = 0
For r = rng.Rows.count To 1 Step -1
v = rng.Cells(r, 1).Value
If Application.WorksheetFunction.CountIf(rng.Columns(1), v) > 1 Then
rng.Rows(r).EntireRow.Delete
n = n + 1
End If
Next r
EndMacro:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Regards,
Ryan---