Delete multiple rows in one go

[sm789]

I have a sheet that pulls data from multiple sheets. In row E I have numbers. There are approximately 5000 rows. Several of these rows have zero value. I need to delete all rows that have zero value in column E. Right now I have a macro that loops thru each row using for/next combo but it takes for ever. Is there a quick way for the code to search all zero value in Column E and delete those rows?

Thank you

 

[mumps]

Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    On Error Resume Next
    Columns("E").Replace "0", "#N/A", xlWhole, , False
    Columns("E").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

 

[sm789]

Try:

Sub DeleteRows()
    Application.ScreenUpdating = False
    On Error Resume Next
    Columns("E").Replace "0", "#N/A", xlWhole, , False
    Columns("E").SpecialCells(xlConstants, xlErrors).EntireRow.Delete
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub

Thank you! It works like a charm when the cell contains a value. But if it is a formula with a resultant value of zero, it ignores that row. Anyway to fix for that?

 

[Rick Rothstein]

Do you have a mix of numbers and formulas in Column E or only formulas? If only formulas, then change xlConstants inside the SpecialCells call to xlFormulas.

 

[kevin9999]

Another option. Change the sheet name to the actual sheet name.

Option Explicit
Sub Delete_Rows_en_masse()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet3")   '*** Change to actual sheet name ***
    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, 5), ws.Cells(LRow, 5))
    ReDim b(1 To UBound(a), 1 To 1)
    
    For i = 1 To UBound(a)
        If a(i, 1) = 0 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

 

[sm789]

Do you have a mix of numbers and formulas in Column E or only formulas? If only formulas, then change xlConstants inside the SpecialCells call to xlFormulas.

Thank you! That worked.

 

[sm789]

Another option. Change the sheet name to the actual sheet name.

Option Explicit
Sub Delete_Rows_en_masse()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet3")   '*** Change to actual sheet name ***
    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, 5), ws.Cells(LRow, 5))
    ReDim b(1 To UBound(a), 1 To 1)
   
    For i = 1 To UBound(a)
        If a(i, 1) = 0 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

Thank you so much!