Sub Delete_Rows(CP_KeyWordCol As String, ShName As String, ColToCheck As String)
Dim RX As Object
Dim a As Variant, b As Variant
Dim nc As Long, i As Long, k As Long
Set RX = CreateObject("VBScript.RegExp")
RX.IgnoreCase = True
With Sheets("Control Panel")
a = Application.Transpose(.Range(CP_KeyWordCol & "42", .Range(CP_KeyWordCol & Rows.Count).End(xlUp)).Value)
If VarType(a) = vbVariant + vbArray Then
RX.Pattern = "\b(" & Replace(Join(Filter(Split("#" & Join(a, "#|#"), "|"), "##", False), "|"), "#", "") & ")\b"
Else
RX.Pattern = "\b" & a & "\b"
End If
End With
With Sheets(ShName)
nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
a = .Range(ColToCheck & "2", .Range(ColToCheck & Rows.Count).End(xlUp)).Value
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
If RX.Test(a(i, 1)) Then
b(i, 1) = 1
k = k + 1
End If
Next i
If k > 0 Then
Application.ScreenUpdating = False
With .Range("A2").Resize(UBound(a), nc)
.Columns(nc).Value = b
.Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
.Resize(k).EntireRow.Delete
End With
Application.ScreenUpdating = True
End If
End With
End Sub