VBA to delete large number of rows

[JSAUS]

Hello!

I need to search column "L" for the item code "126000" and then delete the entire row if that item number is present. Is there a faster way than I'm currently doing it (code below) as the spreadsheet has 15,000+ rows for it to iterate through.....
Is there a way to filter then delete then unfilter?

Sub DeleteRowWithCode()
Last = Cells(Rows.Count, "A").End(xlUp).Row
For i = Last To 1 Step -1
If (Cells(i, "L").Value) = "126000" Then
Cells(i, "A").EntireRow.Delete
End If
Next i

End Sub


Thank you!

 

[montecarlo2012]

try

Sub DeleteRowWithCode()
    ' Turn off screen updating and disable alerts to improve performance
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' Find the last row in column A
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    
    ' Set the range to be filtered
    Set FilterRange = Range("A1:L" & LastRow)
    
    ' Apply the filter to the range
    FilterRange.AutoFilter Field:=12, Criteria1:="126000"
    
    ' Delete the visible rows (excluding the header row)
    FilterRange.Offset(1, 0).Resize(FilterRange.Rows.Count - 1, FilterRange.Columns.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    
    ' Turn off the filter
    FilterRange.AutoFilter
    
    ' Turn on screen updating and re-enable alerts
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

 

[Michael M]

Also try

Sub DeleteRows()
  With Range("L1", Cells(Rows.Count, "L").End(xlUp))
    .Replace "126000", "#N/A", xlWhole, , False, , False, False
    Columns("L").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
  End With
End Sub

 

[kevin9999]

If you were fixed on using a filter, then the following should do what you want:

Option Explicit
Sub Delete_By_Filter()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ change as needed
    
    With ws.Range("A1").CurrentRegion
        .AutoFilter 12, "126000"
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        .AutoFilter
    End With
End Sub

A much faster way is using an array method, such as this:

Sub Delete_By_Array()    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ change as needed
    Dim LRow As Long, LCol As Long, i As Long
    Dim a, b
    
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
    
    a = Range(ws.Cells(2, 12), ws.Cells(LRow, 12))
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        If a(i, 1) = 126000 Then b(i, 1) = 1
    Next i
    
    ws.Cells(2, LCol).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(ws.Columns(LCol))
    
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub

I tested both using 100K rows, with 50k having 126000 (as a number, not text) in column L - the filter method took around 6-7 seconds, the array method took around 0.8 seconds.

 

[JSAUS]

If you were fixed on using a filter, then the following should do what you want:

Option Explicit
Sub Delete_By_Filter()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ change as needed
   
    With ws.Range("A1").CurrentRegion
        .AutoFilter 12, "126000"
        .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
        .AutoFilter
    End With
End Sub

A much faster way is using an array method, such as this:

Sub Delete_By_Array()    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")   '<~~ change as needed
    Dim LRow As Long, LCol As Long, i As Long
    Dim a, b
   
    LRow = ws.Cells.Find("*", , xlFormulas, , xlByRows, xlPrevious).Row
    LCol = ws.Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).Column + 1
   
    a = Range(ws.Cells(2, 12), ws.Cells(LRow, 12))
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
        If a(i, 1) = 126000 Then b(i, 1) = 1
    Next i
   
    ws.Cells(2, LCol).Resize(UBound(a)) = b
    i = WorksheetFunction.Sum(ws.Columns(LCol))
   
    If i > 0 Then
        ws.Range(ws.Cells(2, 1), ws.Cells(LRow, LCol)).Sort Key1:=ws.Cells(2, LCol), _
        order1:=xlAscending, Header:=xlNo
        ws.Cells(2, LCol).Resize(i).EntireRow.Delete
    End If
End Sub

I tested both using 100K rows, with 50k having 126000 (as a number, not text) in column L - the filter method took around 6-7 seconds, the array method took around 0.8 seconds.

Hi @kevin9999

Thanks so much, the Array method is almost working for me. However, it's deleting out my headers (my data is in a table). So I need it to run from row 2 down.

Thank you!

 

[kevin9999]

Glad you were able to adapt it & happy to have helped

 

[JSAUS]

Glad you were able to adapt it & happy to have helped

Sorry, @kevin9999 I haven't actually been able to adapt it yet - I've given it a try! Are you able to tell me how to get it to keep the top row/headers?

Thanks

 

[kevin9999]

Sorry, @kevin9999 I haven't actually been able to adapt it yet - I've given it a try! Are you able to tell me how to get it to keep the top row/headers?

Thanks

Could you provide a small sample of your sheet using the XL2BB add in - it will make helping you much easier.

 

[JSAUS]

Could you provide a small sample of your sheet using the XL2BB add in - it will make helping you much easier.

Unfortunately I can't as I'm on a company computer and we can't download any external addins etc. It's ok, I'll work it out from the start you gave me. Thanks again!

 

[kevin9999]

Unfortunately I can't as I'm on a company computer and we can't download any external addins etc. It's ok, I'll work it out from the start you gave me. Thanks again!

Perhaps if you just copy the range involved & post that (with an indication of where your data starts row/column, and table name).