Optimize delete dupe rows

**Engineers2008** · 01-20-2010, 03:27 PM

I've used this macro in the past to delete all rows where the data in column A is duplicated.

Unfortunately on my latest project, I can't use it because there are 90,000+ values. The macro runs to slow to be of any use.

The code is below. Does anyone know of a way to make this run faster?

Sub Copy_Delete()

Application.ScreenUpdating = False

Dim x As Long
Dim LastRow As Long
     
    LastRow = Range("A100000").End(xlUp).Row
    For x = LastRow To 1 Step -1
        If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x).Text) > 1 Then
            Range("A" & x).EntireRow.Delete
        End If
    Next x

Columns("E:E").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

Application.ScreenUpdating = True
   
End Sub

I also delete all the rows where there is no value in column E, but that's of no importance here.

Thanks in advance guys...

**Palmetto** · 01-20-2010, 04:54 PM

Maybe . . .
Use a helper cell to count the duplicates and return either true (duplicate) or no. A native function in the worksheet is faster than VBA code looping through the range.

Then use Autofilter to filter on true values and use the SpecialCells(xlCellTypeVisible) property to delete visible cells. Be sure to offset from the header row so it doesn't get deleted.

example

    Dim lrow As Long, rRng As Range
    
    lrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
    
    Application.ScreenUpdating = False
    
    With Sheet1
        .Range("A1:A" & lrow).AutoFilter Field:=1, Criteria1:="1"
        Set rRng = .Range("A1:A" & lrow).SpecialCells(xlCellTypeVisible)
        rRng.Offset(1, 0).EntireRow.Delete
    End With
    
    Application.ScreenUpdating = True

**blane245** · 01-20-2010, 04:54 PM

The CountIf function is eating you up. A faster way would be to build a dictionary with the contents of column A as the keys. If you process the rows backwards like you are doing and try to add the current cell's contents to the dictionary, you will get a duplicate if there are already is one, so you can delete that row. The result is the same as what you are getting now, but the duplicates are the last entry rather than the first.