VBA Help - Any way to speed up this code? - Delete Rows Based on Cell Value

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
693
Office Version
  1. 2016
Platform
  1. MacOS
Hi Gang,

Wanted to see if anyone has a way of speeding up a working code. Currently it takes 3-5min on my PC to run this code. Was hoping for a more time efficient update to make this faster, any suggestions are appreciated.

What it does: Looks at column B on my worksheet and finds any cells with the value 0 and deletes the entire row. It starts by passing the headers and looking at my data range from (B7:Bxxxx). For my test the data went from B7:B9007 and expands from column A:J.

Here is the working code:

Code:
Sub DeleteRows()


Dim r As Long
Dim FirstRow As Long
Dim LastRow As Long


'Need to avoid the top header rows
FirstRow = 7
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
For r = LastRow To FirstRow Step -1
If Cells(r, "B") = 0 And Cells(r, "B") = 0 Then
Rows(r).Delete 


End If


Next r


End Sub
 
Last edited:

Excel Facts

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
This should be faster:
Code:
Sub DeleteRows()
Dim FirstRow As Long
Dim LastRow As Long
Dim V As Variant, i As Long
FirstRow = 7
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range("B" & FirstRow, "B" & LastRow)
    V = .Value
    For i = 1 To UBound(V, 1)
        If V(i, 1) = 0 Then V(i, 1) = "#N/A"
    Next i
    .Value = V
    On Error Resume Next
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
 
Upvote 0
@JoeMo That was loads faster, it literally flickered and it was done. I learn something new everyday! Thanks

This should be faster:
Code:
Sub DeleteRows()
Dim FirstRow As Long
Dim LastRow As Long
Dim V As Variant, i As Long
FirstRow = 7
LastRow = Cells(Rows.Count, "B").End(xlUp).Row
Application.ScreenUpdating = False
With Range("B" & FirstRow, "B" & LastRow)
    V = .Value
    For i = 1 To UBound(V, 1)
        If V(i, 1) = 0 Then V(i, 1) = "#N/A"
    Next i
    .Value = V
    On Error Resume Next
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
End With
Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,214,944
Messages
6,122,384
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top