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]

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

No, if that range could look like this (with blank cells) then the code will need adjustment.

An Quala.xlsm
	J
42	Apple
43
44	Pie
45
46	Dog
Control Panel

 

[An Quala]

If possible please adjust it this way, I basically won't need more than 10 cells to value, but it could have empty cell in between which should mean nothing to do with it.

 

[Peter_SSs]

but it could have empty cell in between

Then try this version

Sub Del_Rows_v3()
  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(" & Replace(Join(Filter(Split(Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "#|#"), "|"), "##", False), "|"), "#", "") & ")\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

 

[An Quala]

Hi @Peter_SSs , it is giving the error at

RX.Pattern = "\b(" & Replace(Join(Filter(Split(Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "#|#"), "|"), "##", False), "|"), "#", "") & ")\b"

when there is only 1 value in J42-JDown Field, otherwise it is working fine,

Also I want to replicate this code 2 more times in the same SUB, with different sheet and source range, so should I just use different variables, right?

 

[Peter_SSs]

Hi @Peter_SSs , it is giving the error .... when there is only 1 value in J42-JDown Field

Yes, it would do that. Make this change in the code

  With Sheets("Control Panel")
    RX.Pattern = "\b(" & Replace(Join(Filter(Split(Join(Application.Transpose(.Range("J42", .Range("J" & Rows.Count).End(xlUp)).Value), "#|#"), "|"), "##", False), "|"), "#", "") & ")\b"
    a = Application.Transpose(.Range("J42", .Range("J" & 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

Also I want to replicate this code 2 more times in the same SUB, with different sheet and source range

It makes helping harder when the problem keeps changing little-by-little.
First it was only a single cell in 'Control Panel' that had a word to check for.
Then it became a range of cells (with blanks possible)
Now we are looking at extra sheets and changed ranges.

Please review all the Forum Use Guidelines, but in particular 5a which says

1. State your question clearly, including your entire need at the start.

So, before we move forward further, could you please give us all the details of your entire requirement for this thread?

 

[An Quala]

So, before we move forward further, could you please give us all the details of your entire requirement for this thread?

So here are the details:

1st: Pick the value from the range of J42-JDown in "Control Panel" and delete the entire rows if that value comes in phrase word form of the column AM of sheet "Sponsored Products Campaigns", now ideally we should be able to leave any cell blank in the range, and it will just ignore this cell but if the other way around which is no cell in between the range should be left blank, makes the things easier or faster, we can go with that way as well,

Now the 2nd and 3rd part of this code will be:

Instead of range J42-JDown, we have L42-LDown and N42-Ndown from the same sheet "Control Panel" but for L, we will check the value in Column AX in sheet "Sponsored Brands Campaigns" and for N, we will check in the Column AO in sheet "Sponsored Display Campaigns",

But important point is these all 3 codes should be separated from each other because they will be running in different parts of a single SUB, so they should be independent.

Highly appreciated, thank you!

 

[Peter_SSs]

Thank you for the clear description.

But important point is these all 3 codes should be separated from each other because they will be running in different parts of a single SUB, so they should be independent.

Rather than repeating a quite long and very similar code three times, we can still use a single code just passing the relevant information to the code each time. Here is the code that would delete the rows.

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

And this is how you could use it in your separate main sub

Sub Mainprocedure()
  'Could have code here
  
  'Then say we want to delete the relevant rows from 'Sponsored Brands Campaigns'
  Delete_Rows "L", "Sponsored Brands Campaigns", "AX"
  
  'Could have code here
  
  'Then say we want to delete the relevant rows from 'Sponsored Products Campaigns'
  Delete_Rows "J", "Sponsored Products Campaigns", "AM"
  
  'Could have code here
  
  'Then say we want to delete the relevant rows from 'Sponsored Display Campaigns'
  Delete_Rows "N", "Sponsored Display Campaigns", "AO"
  
  'Could have code here
  
End Sub

 

[An Quala]

Thank you so much for the great code

 

[Peter_SSs]

can you please look into it,

Not possible to look into it without knowing what value you passed to the procedure for CP_KeyWordCol and what value(s) are in that column and in what rows in 'Control Panel'.

Please post the line of code in your main procedure that called the Delete_Rows procedure when this error occurred.

 

[An Quala]

Hello @Peter_SSs The code is working perfectly well when there is at least one value, but if we skip all the cells empty, then it deletes all the data, can you please correct this as well?