Delete Entire rows other then a ceratin word in column A

[zone709]

Hi probably a cleaner way of doing this.

If the word "Topper" in column A exists. Then keep those rows and delete everything else. So you see down below I had to filter Tunnel and Yards Slabs in order to delete them and keep Topper.

Sub Mac9()


    Columns("A:A").AutoFilter
    ActiveSheet.Range("$A$1:$A$170").AutoFilter Field:=1, Criteria1:=Array( _
        "Tunnel", "Yards Slab", "="), Operator:=xlFilterValues
    Rows("73:148").Delete Shift:=xlUp
    Selection.AutoFilter
  
End Sub

 

[Fluff]

Why not just filter for doesn't equal topper

Sub Mac9()
    Range("$A$1:$A$170").AutoFilter 1, "<>Topper"
    Rows("73:148").Delete Shift:=xlUp
    ActiveSheet.AutoFilterMode = False
End Sub

 

[Peter_SSs]

I'm guessing that your posted code was originally from the macro recorder as the deletion rows seem very specific and unrelated to the filtered rows so I'm suggesting a change to that.
Also, a minor point but when deleting whole rows there is no need to specify Shift:=xlUp as there is no other way for them to move.

Sub Mac9_v2()
  With Range("A1:A170")
    .AutoFilter Field:=1, Criteria1:="<>Topper"
    .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
    .AutoFilter
  End With
End Sub

 

[Rick Rothstein]

Here is another way that should work...

Sub KeepTopperRowsDeleteAllOtherRows()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate("IF(" & .Address & "=""Topper"",""Topper"","""")")
    On Error Resume Next
    .SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
  End With
End Sub

 

[zone709]

Here is another way that should work...

Sub KeepTopperRowsDeleteAllOtherRows()
  With Range("A2", Cells(Rows.Count, "A").End(xlUp))
    .Value = Evaluate("IF(" & .Address & "=""Topper"",""Topper"","""")")
    On Error Resume Next
    .SpecialCells(xlBlanks).EntireRow.Delete
    On Error GoTo 0
  End With
End Sub

Thanks guys for all the help. Works great ?

 

[Peter_SSs]

Thanks guys for all the help. Works great ?

You're welcome.

I don't know if it is possible with your worksheet but if any of the data this is acting on might already filtered before the code is run the codes would need to ensure all rows are visible first. If not ..
- For my code if the filtering is only on column A there would be no problem, but if any other column is filtered my code may not delete all the non-Topper rows
- For Rick's code, not only could it miss deleting some non-Topper rows, it could actually overwrite some non-Topper values with "Topper".

If filtering is a possibility, then either code would benefit from the additional first line shown below. Even if no filtering is present, the extra line would do no harm.

Sub Mac9_v3()
  If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
  With Range("A1:A170")
    .AutoFilter Field:=1, Criteria1:="<>Topper"
    .Offset(1).Resize(.Rows.Count - 1).EntireRow.Delete
    .AutoFilter
  End With
End Sub