Sub ACT()
    Dim rRng As Range
    Dim lr As Long, i As Long

    lr = Cells(Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lr
        If Cells(i, 7).Value <> "AC" And Cells(i, 7).Value <> "AS" And Cells(i, 7).Value <> "NV" And Cells(i, 7).Value <> "PA" Then
            If rRng Is Nothing Then
                Set rRng = Cells(i, 1)
            Else
                Set rRng = Union(rRng, Cells(i, 1))
            End If
        End If
    Next i
    
    If Not rRng Is Nothing Then
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            .EnableEvents = False
        End With
        
        rRng.EntireRow.Delete
        Set rRng = Nothing
    
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
            .EnableEvents = True
        End With
    End If
End Sub

        If Cells(i, 7).Value <> "AC" Then
            If Cells(i, 7).Value <> "AS" Then
                If Cells(i, 7).Value <> "NV" Then
                    If Cells(i, 7).Value <> "PA" Then