Delete duplicate rows

[richiwatts]

I want to check if there are any doubles in column F and they there is then delete the entire row for any duplicates. I just was to keep the first occurrance. Duplicate rows may not be on top of each other. How would I do that?

Rich

 

[tigersden]

Hi Rich,
You could try this code below. I found it either on this board or the net but have modified it it a little bit with a message box etc.
Just put this in a module.

Tim

Public Sub DeleteDuplicateRows()
Dim intCol, intX As Integer
Dim lngR, lngN As Long
Dim V As Variant
Dim Rng As Range

Range("F1").End(xlDown).Select
ActiveCell.Offset(0, 0).Select
On Error GoTo EndMacro
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

intCol = ActiveCell.Column

If Selection.Rows.Count > 1 Then
Set Rng = Selection
Else
Set Rng = ActiveSheet.UsedRange.Rows
End If

lngN = 0
For lngR = Rng.Rows.Count To 1 Step -1
V = Rng.Cells(lngR, 1).Value
If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then
Rng.Rows(lngR).EntireRow.Delete
lngN = lngN + 1
End If

Next lngR

'Show User Duplicates have been found
If lngN >= 1 Then
MsgBox lngN & " Duplicate Records have been deleted", vbExclamation, "Duplicate Records Found!"
End If

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
EndMacro:
End Sub