Delete all rows that don't start with CRN or AT

[mdmackillop]

The code uses autofilter to find any rows starting with the strings listed in StartToKeep array and insets an X in a corresponding column. It does this for each term. It then searches that column for blanks and deletes all rows found. Finally, it searches for Atalanta, and deletes all rows found. I've amended my code in the attached example to keep blanks in Column A

 
Option Explicit

Sub KeepSelectedRows()
    Dim StartToKeep, STK
    Application.ScreenUpdating = False
    StartToKeep = Array("AT*", "CRN*", "=")
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    'Mark rows to keep
    For Each STK In StartToKeep
        Cells.AutoFilter Field:=1, Criteria1:=STK
        Intersect(ActiveSheet.UsedRange, _
       Columns(1).SpecialCells(xlCellTypeVisible)).Offset(, 6) = "x"
       Cells.AutoFilter
    Next
    'Delete unmarked rows
    Rows(1).Insert
    Cells(1, 1) = "Sacrifice"
    Cells.AutoFilter Field:=7, Criteria1:="="
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    'Delete ATalanta rows
    Cells.AutoFilter Field:=1, Criteria1:="ATalanta*"
    Intersect(ActiveSheet.UsedRange, _
    Columns(1).SpecialCells(xlCellTypeVisible)).EntireRow.Delete
    'Clear filter column
    Columns(7).ClearContents
    Application.ScreenUpdating = True
End Sub