'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 |
