For everyone who wants to delete duplicates in a column

Smokin'

SearchValue = Range("A" & x).Value If SearchValue = "zzzdeletemezzz" Then Else With Range("A1:A" & LastRow) Set c = .Find(what:=SearchValue, LookIn:=xlValues, lookat:=xlWhole) FirstAddress = c.Address Set c = .FindNext(c) If c.Address = FirstAddress Then Else Range(c.Address).FormulaR1C1 = "zzzdeletemezzz" Counter = Counter + 1 End If End With End If Next x If Range("A" & x).Value = "zzzdeletemezzz" Then Rows(x).Delete LastRow = LastRow - 1 Else x = x + 1 End If Loop While x < LastRow + 1

Or .....

..... avoiding the use of any loops :-

Sub DeleteDuplicates()
'Deletes rows with duplicates in Column A
Dim rng As Range
Application.ScreenUpdating = False
Columns("A:B").Insert
Set rng = Range(Range("C1"), Range("C65536").End(xlUp)).Offset(0, -2)
With Range("A1")
.Value = 1
.AutoFill Destination:=rng.Offset(0, -2), Type:=xlFillSeries
End With
With rng
.EntireRow.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlNo
.Offset(1, 1).FormulaR1C1 = "=IF(RC[1]&RC[2]=R[-1]C[1]&R[-1]C[2],1,"""")"
On Error Resume Next
.Offset(1, 1).SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
.EntireRow.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo
.Resize(, 2).EntireColumn.Delete
End With
End Sub

Although the above code is not from the macro recorder, all of the actions performed by this macro can in fact be recorded with the macro recorder(and can work without any "tweaking") - knowledge of VBA is therefore not necessary (not so, if loops are used).

If anyone is interested, will post on request the manual way (macro-recordable) to delete duplicates from a column.

SearchValue = Range("A" & x).Value If SearchValue = "zzzdeletemezzz" Then Else With Range("A1:A" & LastRow) Set c = .Find(what:=SearchValue, LookIn:=xlValues, lookat:=xlWhole) FirstAddress = c.Address Set c = .FindNext(c) If c.Address = FirstAddress Then Else Range(c.Address).FormulaR1C1 = "zzzdeletemezzz" Counter = Counter + 1 End If End With End If Next x If Range("A" & x).Value = "zzzdeletemezzz" Then Rows(x).Delete LastRow = LastRow - 1 Else x = x + 1 End If Loop While x < LastRow + 1

Re: Or .....use Bob umlas amended macro (NT)

: This will do the trick : Option Explicit : Sub DeleteDuplicates() : Application.ScreenUpdating = False : Dim x As Integer : Dim LastRow As Integer : Dim c As Range : Dim FirstAddress As String : Dim SearchValue As String : Dim Counter As Integer : LastRow = Range("A65536").End(xlUp).Row : For x = 1 To LastRow : : SearchValue = Range("A" & x).Value : : If SearchValue = "zzzdeletemezzz" Then : Else : : With Range("A1:A" & LastRow) : : Set c = .Find(what:=SearchValue, LookIn:=xlValues, lookat:=xlWhole) : FirstAddress = c.Address : Set c = .FindNext(c) : : If c.Address = FirstAddress Then : Else : Range(c.Address).FormulaR1C1 = "zzzdeletemezzz" : Counter = Counter + 1 : End If : : End With : : End If : : Next x : x = 1 : Do : : If Range("A" & x).Value = "zzzdeletemezzz" Then : Rows(x).Delete : LastRow = LastRow - 1 : Else : x = x + 1 : End If : : Loop While x < LastRow + 1 : : MsgBox (Counter & " duplicates have been deleted."), vbInformation, "Deletion Complete" : End Sub : : HTH : Jacob

Yes, that's better. And also .......

..... using Bob's formula, but avoiding the loop to make it macro-recordable :-

Sub DeleteDuplicates()
Dim rng As Range
Application.ScreenUpdating = False
Columns("A:A").Insert
Set rng = Range(Range("B1"), Range("B65536").End(xlUp)).Offset(0, -1)
With rng
.FormulaR1C1 = "=IF(COUNTIF(R1C2:RC[1],RC[1])>1,1,"""")"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
.EntireColumn.Delete
End With
End Sub