Jaymes
Jaymes

Reputation: 37

Trying to delete rows with cells that have same value as previous in VBA

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

Answers (3)

Gowtham Shiva
Gowtham Shiva

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

Scott Craner
Scott Craner

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

Petay87
Petay87

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

Related Questions