Exception to a rule within a Macro

[Livin404]

Greetings, I have the macro below which works perfectly in removing rows if a column contains specific text. I would like to add an exception to the rule. If I have "B737", "A310", "B767" , or "B777" in Column C I would like those rows NOT to be removed if otherwise would be removed based on the macro: Thank you,

Sub Delete_locals()
With ActiveSheet
.AutoFilterMode = False
With Range("H1", Range("H" & Rows.Count).End(xlUp))
.AutoFilter 1, "*CHS*"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
With ActiveSheet
.AutoFilterMode = False
With Range("H1", Range("H" & Rows.Count).End(xlUp))
.AutoFilter 1, "*777*"
On Error Resume Next
.Offset(1).SpecialCells(12).EntireRow.Delete
End With
.AutoFilterMode = False
End With
End Sub

 

[AlphaFrog]

Sub Delete_locals()
    Dim rngExclude As Range
    
    With ActiveSheet
        .AutoFilterMode = False
        With Range("C1", Range("C" & Rows.Count).End(xlUp))
            .AutoFilter 1, Array("B737", "A310", "B767", "B777"), Operator:=xlFilterValues
            On Error Resume Next
            Set rngExclude = .Offset(1).SpecialCells(12).EntireRow
        End With
        .AutoFilterMode = False
        
        With Range("H1", Range("H" & Rows.Count).End(xlUp))
            .AutoFilter 1, Array("*CHS*", "*777*"), Operator:=xlFilterValues
            On Error Resume Next
            rngExclude.Hidden = True
            .Offset(1).SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
    
End Sub

 

[6StringJazzer]

You are using autofilter to do this and unfortunately autofilter can only give you two criteria. This code will do it with a loop:

Sub Delete_locals()

   Dim R As Long ' row
   
   For R = 2 To Range("H1", Range("H" & Rows.Count).End(xlUp))
      If (Cells(R, "H") Like "*CHS*" Or _
          Cells(R, "H") Like "*777*") And _
         Not Cells(R, "C") Like "*B737*" And _
         Not Cells(R, "C") Like "*A310*" And _
         Not Cells(R, "C") Like "*B767*" And _
         Not Cells(R, "C") Like "*B777*" Then
         
         Rows(R).Delete
         
   Next R
   
End Sub

 

[Peter_SSs]

This code will do it with a loop:

Did you test that code?


Advanced Filter would also be a possibility. I have assumed A1.CurrentRegion as the data to be filtered and that column Z is available to use as a helper. Both of those of course can be changed if required.

Sub Del_data()
  Range("Z2").Formula = "=AND(OR(ISNUMBER(SEARCH(""CHS"",H2)),ISNUMBER(SEARCH(""777"",H2))),NOT(OR(C2={""B737"",""A310"",""B767"",""B777""})))"
  With Range("A1").CurrentRegion
    .AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("Z1:Z2"), Unique:=False
    .Offset(1).EntireRow.Delete
    If .Parent.FilterMode Then .Parent.ShowAllData
  End With
  Range("Z2").ClearContents
End Sub

 

[6StringJazzer]

Did you test that code?

A fair question. No. I always test when I have the file (or at least data), but I was not going to spend time to re-create the OP's file without knowing what data he has. Bug reports are more than welcome.

 

[Livin404]

Sub Delete_locals()
    Dim rngExclude As Range
  
    With ActiveSheet
        .AutoFilterMode = False
        With Range("C1", Range("C" & Rows.Count).End(xlUp))
            .AutoFilter 1, Array("B737", "A310", "B767", "B777"), Operator:=xlFilterValues
            On Error Resume Next
            Set rngExclude = .Offset(1).SpecialCells(12).EntireRow
        End With
        .AutoFilterMode = False
      
        With Range("H1", Range("H" & Rows.Count).End(xlUp))
            .AutoFilter 1, Array("*CHS*", "*777*"), Operator:=xlFilterValues
            On Error Resume Next
            rngExclude.Hidden = True
            .Offset(1).SpecialCells(12).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With
  
End Sub

I tried the macro with your insertion, and it still deleted it.

You are using autofilter to do this and unfortunately autofilter can only give you two criteria. This code will do it with a loop:

Sub Delete_locals()

   Dim R As Long ' row
  
   For R = 2 To Range("H1", Range("H" & Rows.Count).End(xlUp))
      If (Cells(R, "H") Like "*CHS*" Or _
          Cells(R, "H") Like "*777*") And _
         Not Cells(R, "C") Like "*B737*" And _
         Not Cells(R, "C") Like "*A310*" And _
         Not Cells(R, "C") Like "*B767*" And _
         Not Cells(R, "C") Like "*B777*" Then
        
         Rows(R).Delete
        
   Next R
  
End Sub

Hi, I was just doing an OPS check, and I got an error. Compile error "Next without For". Please see image. Thank you,

 

[GWteB]

@Livin404, VBA's error checking isn't always accurate. Actually there is a missing End If between Rows(R).Delete and Next

 

[Livin404]

@Livin404, VBA's error checking isn't always accurate. Actually there is a missing End If between Rows(R).Delete and Next

Thank you, I did put an

End IF

between Rows(R).Delete and Next and now I get a run-time-error "13". The very top line For R=2... gets highlighted.

 

[GWteB]

It seems to me that that particular line should be

For r = 2 To Range("H1", Range("H" & Rows.Count).End(xlUp)).Rows.Count

For other unexpected issues regarding this code, I would recommend you wait for @6StringJazzer's response.

 

[6StringJazzer]

It seems to me that that particular line should be

For r = 2 To Range("H1", Range("H" & Rows.Count).End(xlUp)).Rows.Count

For other unexpected issues regarding this code, I would recommend you wait for @6StringJazzer's response.

My original code returned the cell, not the row number. However, you do not want Rows.Count at the end, you want Row.

If the OP can find a way to share his file I would be very happy to thoroughly test the code. In the meantime I see two other solutions posted that I have seen no other comment on. They might be perfectly fine.