Home » excel » excel vba – VBA Looping Over Sheets: Delete rows if cell doesn't contain

excel vba – VBA Looping Over Sheets: Delete rows if cell doesn't contain

Posted by: admin May 14, 2020 Leave a comment

Questions:

I am trying to loop over excel worksheets to delete rows not containing “ALTW.ARNOLD_1” or “DECO.FERMI2”. I have assembled the following code which works on a single worksheet, but when I loop the loop just runs through all sheets while only performing the row deletion on the first sheet. The sheets are numbered 1 through 365. Here’s the code:

Sub Delete_Rows()

For x = 1 To 365
    Sheets(x).Select
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)
    For Each cell In rng
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
    If del Is Nothing Then
    Set del = cell
    Else: Set del = Union(del, cell)
    End If
    End If
    Next cell
    On Error Resume Next
    del.EntireRow.Delete
Next x

End Sub
How to&Answers:

Much safer to avoid the select/activate altogether. You also were not resetting del after each loop…

Sub Delete_Rows()

Dim rng As Range, cell As Range, del As Range
dim sht as Worksheet

For x = 1 To 365
    set sht=Sheets(x)
    set del=Nothing 'you missed this

    Set rng = Intersect(sht.Range("A1:A5000"), sht.UsedRange)
    For Each cell In rng.Cells
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
        If del Is Nothing Then
            Set del = cell
        Else
            Set del = Union(del, cell)
        End If
    End If
    Next cell
    If not del is nothing then del.EntireRow.Delete
Next x

End Sub

Answer:

del is a range of cells, when you get to the EntireRow.Delete line, you need to loop through each cell in the del range.

For x = 1 To 365
    Sheets(x).Select
    Dim rng As Range, cell As Range, del As Range
    Set rng = Intersect(Range("A1:A5000"), ActiveSheet.UsedRange)
    For Each cell In rng
    If (cell.Value) <> "ALTW.ARNOLD_1" And (cell.Value) <> "DECO.FERMI2" _
    Then
    If del Is Nothing Then
    Set del = cell
    Else: Set del = Union(del, cell)
    End If
    End If
    Next cell
    On Error Resume Next
    For each cell in dell.cells
        cell.EntireRow.Delete
    Next cell
Next x