Delete the entire row if it's column has specific value

[An Quala]

Hello Mr Excel Community, can anyone please help me to write a code which deletes the entire rows if column AM contains a value which is in sheet "Control Panel" Cell S7, it will be the phrase match, so for example if cell S7 has value "Apple" then it should delete the row with the value of "Apple Juice" in Column AM.

Thank you.

 

[Peter_SSs]

Try adding the 4 blue lines where shown.

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")
    If .Range(CP_KeyWordCol & Rows.Count).End(xlUp).Row >= 42 Then
      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 If
  End With
  
  If Len(RX.Pattern) > 0 Then
    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 If
End Sub