Delete Rows which contains a specific text in a cell

[An Quala]

Hello, can anyone please help me to write a code which delete all the rows if Column AM in sheet "Sponsored Products Campaigns" has text as same as in sheet "Control Panel" Cell S7, so for example it will search the text from Cell S7 Sheet "Control Panel" in the Column AM sheet "Sponsored Products Campaigns" and delete all the rows which have the same text, thank you so much.

Note: Please note that the match is not exact like if cell S7 has "kitchen" so we will need to delete the row with "kitchen tools" as well.

 

[rlv01]

One way.

Sub DeleteSpecificText()
    Dim WS1 As Worksheet, WS2 As Worksheet
    Dim FilterRange As Range, DataRange As Range, DeleteRange As Range
    Dim BadText As String
    
    Set WS1 = ThisWorkbook.Worksheets("Control Panel")
    Set WS2 = ThisWorkbook.Worksheets("Sponsored Products Campaigns")
    
    BadText = Trim(WS1.Range("S7").Value)
    
    WS2.AutoFilterMode = False
    Application.ScreenUpdating = False
    
    With WS2
        Set FilterRange = .Range("AM1:AM" & .Range("AM" & .Rows.Count).End(xlUp).Row)    'FilterRange must always include a header row
    End With
    
    With FilterRange
        Set DataRange = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
    End With
    
    FilterRange.AutoFilter Field:=1, Criteria1:="*" & BadText & "*"   'Adjust Field as required
    Set DeleteRange = Application.Intersect(FilterRange.SpecialCells(xlCellTypeVisible).EntireRow, DataRange.EntireRow)
    
    WS2.AutoFilterMode = False
    
    If Not DeleteRange Is Nothing Then
        DeleteRange.Delete                            'delete visible rows
    End If
    Application.ScreenUpdating = True
End Sub