'Adding multiple criteria to search specific words in a columns and delete entire rows

This is the code below (provided by VBasic2008), it works great for a single value to search and delete but:

1- I need to add more values (Fired, Leave, Employed, 3rd Party, Return) in the same column. I tried to add other with commas, AND and others but I could not work out.

2- I need to do the same process in column CE with other values (1NotEmployee, 0NotEmployee). Is it possible to add this condition to the same code or should I create a separate module for it?

Sub DeleteResigned()
    
    Dim dt As Double: dt = Timer
    
    Const FirstCriteriaCellAddress As String = "O1"
    Const Criteria As String = "Resigned"

    Application.ScreenUpdating = False

    ' Reference the worksheet and remove any filters.
    Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
    If ws.FilterMode Then ws.ShowAllData
    
    ' Reference the range.
    Dim fCell As Range: Set fCell = ws.Range(FirstCriteriaCellAddress)
    Dim rg As Range: Set rg = fCell.CurrentRegion
    
    ' Calculate the column index.
    Dim cIndex As Long: cIndex = fCell.Column - rg.Column + 1
    
    With rg.Columns(cIndex)
        ' Check if any criteria.
        If Application.CountIf(.Resize(.Rows.Count - 1).Offset(1), Criteria) _
                = 0 Then
            Application.ScreenUpdating = True
            MsgBox "No criteria found", vbExclamation
            Exit Sub
        End If
        ' Insert a helper column containing an ascending integer sequence.
        .Insert xlShiftToRight, xlFormatFromRightOrBelow
        With .Offset(, -1)
            .NumberFormat = 0
            .Value = ws.Evaluate("ROW(" & .Address & ")")
        End With
    End With
    
    ' Sort the range by the criteria column.
    rg.Sort rg.Columns(cIndex + 1), xlAscending, , , , , , xlYes
    
    ' Reference the data range (no headers).
    Dim drg As Range: Set drg = rg.Resize(rg.Rows.Count - 1).Offset(1)
    
    ' Filter the data of the criteria column.
    rg.AutoFilter cIndex + 1, Criteria
    
    ' Reference the visible data rows of the filtered range and delete them.
    Dim vdrg As Range: Set vdrg = drg.SpecialCells(xlCellTypeVisible)
    ws.AutoFilterMode = False
    vdrg.Delete xlShiftUp
    
    ' Sort by and delete the helper column.
    rg.Sort rg.Columns(cIndex), xlAscending, , , , , , xlYes
    rg.Columns(cIndex).Delete xlShiftToLeft
    
    Application.ScreenUpdating = True
    
    Debug.Print Timer - dt

    MsgBox "Rows deleted.", vbInformation
    
End Sub


Solution 1:[1]

You should add a Select case statement to make it easier

Dim criteria As String

Select Case True
 Case criteria Like "Resigned", "Fired", "Leave", "Employed", "3rd Party", "Return"
  Your code here
 Case else
  What does it do if it can't find the value..
End Select

For the 2nd process, I'd do another select clause to avoid troubles when debugging.

Hope it helps!

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1