Reputation: 37
I am trying remove duplicate records using the A column, and I seem to have some success, but I have still found duplicates. Hoping someone will tell me what I can do to improve this.
Thanks
Dim i As Integer
Dim value As String
i = 3
Range("A" & i).Select
Do Until IsEmpty(ActiveCell)
Range("A" & i).Select
value = ActiveCell.value
Do Until IsEmpty(ActiveCell)
If ActiveCell.value = value Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
i = i + 1
Loop
Upvotes: 0
Views: 2707
Reputation: 3875
When you delete a row, you need to loop through in reverse. Try the below code,
Sub removeDupes()
Dim i As Long
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
If Range("A" & i).Value = Range("A" & i + 1).Value Then
Range("A" & i + 1).ClearContents
End If
Next i
For i = Cells(Rows.Count, 1).End(xlUp).Row To 3 Step -1
If IsEmpty(Range("A" & i)) Then
Range("A" & i).EntireRow.Delete
End If
Next i
End Sub
Upvotes: 1
Reputation: 152450
Avoid using select and active cell.
Use a For loop that loops backwards.
Dim i As Long
Dim ws As Worksheet
Set ws = ActiveSheet 'This can be changed to a specific sheet: Worksheets("sheetName")
With ws
For i = .Cells(.Rows.Count, 1).End(xlUp).Row To 3 Step -1
If .Cells(i, 1).value = .Cells(i - 1, 1).value Then
.Rows(i).Delete
End If
Next i
End With
This will only compare the value to the one above. If you want to remove all duplicates use @Petay87 answer.
Upvotes: 4
Reputation: 1773
I believe the following will work for you if you are removing the duplicates for all of column A and it does not have a header row:
ActiveSheet.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlNo
Upvotes: 3