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]

@An Quala
About how many rows is the original data likely to be?

 

[EXCEL MAX]

Correction...
replace "For Each vR In vRng" with "For Each vR In vRngJ42"

 

[An Quala]

@Peter_SSs In the range of 100-10000

 

[An Quala]

Hi @bebo021999 I see that your autofilter code is working faster, can you please add a range of J42-J46 instead of only J42 but need to add one condition for each row, which is if the corresponding H column which is H42-H46 range, is "Turn On" then take the value/run the code of deleting (because otherwise it is deleting everything considering empty space),

So for example if H24 = "Turn On", then take the value of J42 and check in the AQ Column of "Sponsored Products Campaigns", and the delete the entire rows, and so on...

That would be really helpful, thank you.

 

[Peter_SSs]

if column AM contains a value which is in sheet "Control Panel" ... so for example if.. has value "Apple" then it should delete the row with the value of "Apple Juice"

.. but should it delete or leave the row if it contains "Pineapple juice"

That is, are you looking for word matches or just text string matches?

 

[An Quala]

Word matches is better for me like if there is "Apple" it should not delete "Pineapple", if it's possible.

 

[Peter_SSs]

Try this with a copy of your data.
It should do word matches only and especially if you have a large number of rows (like 10,000 you suggested) and lots of scattered rows to delete it should be much faster than the other approaches suggested so far.
The code uses the values in 'Control Panel' from J42 down until it runs out of values. I have assumed no blank cells in the J42 and down list.

Sub Del_Rows()
  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")
    RX.Pattern = "\b(" & Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
  End With

  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("AM2", Range("AM" & 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 Sub

 

[An Quala]

Try this with a copy of your data.
It should do word matches only and especially if you have a large number of rows (like 10,000 you suggested) and lots of scattered rows to delete it should be much faster than the other approaches suggested so far.
The code uses the values in 'Control Panel' from J42 down until it runs out of values. I have assumed no blank cells in the J42 and down list.

Sub Del_Rows()
  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")
    RX.Pattern = "\b(" & Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
  End With

  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("AM2", Range("AM" & 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 Sub

The code seems not working, maybe because I can't see any reference to other sheet where it is supposed to delete the rows in the "Sponsored Products Campaigns", also when I am checking the code with F8 Step Into, it is looping around for and next and not going through making it hard to catch the error.

 

[An Quala]

@Peter_SSs Please also clarify one thing, whenever we leave any cell blank after j42, it will just ignore it right?

 

[Peter_SSs]

maybe because I can't see any reference to other sheet where it is supposed to delete the rows in the "Sponsored Products Campaigns"

I missed the particular sheet name reference and thought the code was acting on the active sheet. Try this instead

Sub Del_Rows_v2()
  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")
    RX.Pattern = "\b(" & Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "|") & ")\b"
  End With
  
  With Sheets("Sponsored Products Campaigns")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("AM2", .Range("AM" & 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