Delete Rows If Contains Certain Multiple Values

julia55

Board Regular
Joined
Dec 2, 2010
Messages
73
I am looking for a macro that will delete the entire row if the cells contain any values in a certain list of values. My preference would be to store the list of values on another sheet within the spreadsheet. I have a few things that are making this very complicated.

1. I have multiple sheets which I need to run this macro on, and the column is different on one sheet than it is from the rest. Sheet1 & Sheet2 is column K, Sheet3 is column J. The data will always be in these columns.
2. The list of values I want to delete is pretty long, more than 37 different values (leaving only certain values is not really an option). I will add to this list every week as I run new reports.

I am using the code below right now and I have a seperate macro for each value I want it to delete and I call all of these macros in another macro, this is obviously becoming very cumbersome and I need a simpler solution.

Code:
If ActiveSheet.Name = "Tracking System Compliance" Then
Range("J:J").Select

Else: Range("K:K").Select
End If

    Dim c As Range
    Dim SrchRng
    Set SrchRng = Selection
    Do
        Set c = SrchRng.Find("ACCUT", LookIn:=xlValues, LookAt _
        :=xlPart)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
I'm assuming the code you posted works, but you just need to add multiple criteria in the find.
AND you put the list of criteria in a Range somewhere, say Sheet2 A1:A37 for example.

Rich (BB code):
If ActiveSheet.Name = "Tracking System Compliance" Then
Range("J:J").Select

Else: Range("K:K").Select
End If

    Dim c As Range, MyVals As Range, x As Range
    Dim SrchRng
    Set SrchRng = Selection

    'This is a range containing all the criteria to search for
    Set MyVals = Sheets("Sheet1").Range("A1:A37")

    Do
        For Each x In MyVals
            Set c = SrchRng.Find(x.Value, LookIn:=xlValues, LookAt _
            :=xlPart)
            If Not c Is Nothing Then c.EntireRow.Delete
        Next x
    Loop While Not c Is Nothing
 
Upvote 0
Hello,

I found this post while searching for a similar solution and have successfully used the macro suggested by Jonmo1.

However, when the list I am searching through contains multiple rows with one of the values that needs to be deleted, instead of deleting all the rows with that value, it only deletes one of the rows. The code will only delete all the rows with that value if I reduce the list of criteria from 80 values down to that one value, but, I need it to work when searching through all 80 different values.

Below is my current code, and the name of sheet with the list of predetermined values is named "exempt". The values are names of companies like ABC Construction, or XYZ Builders, etc.

What changes do I need to make to the code in order to delete all the rows that may be found when searching my selection? Thank you so much for your help!


Code:
[COLOR=#333333]Sub delete_exempt()[/COLOR]

[COLOR=#333333]Dim c As Range, MyVals As Range, x As Range[/COLOR]
[COLOR=#333333]Dim SrchRng[/COLOR]
[COLOR=#333333]Set SrchRng = Selection[/COLOR]

[COLOR=#333333]'This is a range containing all the criteria to search for[/COLOR]
[COLOR=#333333]Set MyVals = Sheets("exempt").Range("A1:A80")[/COLOR]

[COLOR=#333333]Do[/COLOR]
[COLOR=#333333]For Each x In MyVals[/COLOR]
[COLOR=#333333]Set c = SrchRng.Find(x.Value, LookIn:=xlValues, LookAt _[/COLOR]
[COLOR=#333333]:=xlPart)[/COLOR]
[COLOR=#333333]If Not c Is Nothing Then c.EntireRow.Delete[/COLOR]
[COLOR=#333333]Next x[/COLOR]
[COLOR=#333333]Loop While Not c Is Nothing[/COLOR]

[COLOR=#333333]End Sub[/COLOR]
 
Upvote 0
Welcome to the board.

I think a different approach should be used here.
The code in this thread worked because it was assumed the value would only exist once.

You probably need to go row by row, checking if the value matches your list of values.

Try
IMPORTANT, make sure there are no blanks in your list of criteria.
Code:
Sub delete_exempt()
Dim c As Range, MyVals As Range, SrchRng As Range
Dim i As Long, lr As Long, x
Set SrchRng = Selection
'This is a range containing all the criteria to search for
Set MyVals = Sheets("exempt").Range("A1:A80")
lr = SrchRng.Rows.Count
For i = lr To 1 Step -1
    For Each c In MyVals
        x = InStr(SrchRng(i), c)
        If x > 0 Then
            SrchRng(i).EntireRow.Delete
            Exit For
        End If
    Next c
Next i
End Sub
 
Upvote 0
Jonmo1, thanks! This worked great.

I will most likely be adding additional criteria on a regular basis, so how would I account for a growing range of criteria without having to go in and edit the macro every time I added a new criteria to the list?
 
Upvote 0
Never mind, I changed the range from .Range("A1:A80") to .UsedRange and it worked when I added another row to my criteria list. See below code update...

Code:
Sub delete_exempt_works()


'select only the cells you want searched, not entire column


Worksheets("exempt").UsedRange


Dim c As Range, MyVals As Range, SrchRng As Range
Dim i As Long, lr As Long, x
Set SrchRng = Selection


'This is a range containing all the criteria to search for
Set MyVals = Sheets("exempt").UsedRange
lr = SrchRng.Rows.Count
For i = lr To 1 Step -1
    For Each c In MyVals
        x = InStr(SrchRng(i), c)
        If x > 0 Then
            SrchRng(i).EntireRow.Delete
            Exit For
        End If
    Next c
Next i


End Sub

Thanks again for the help!!
 
Upvote 0
Try
Code:
Sub delete_exempt()
Dim c As Range, MyVals As Range, SrchRng As Range
Dim i As Long, lr1 As Long, lr2 As long, x

'This is a range containing all the criteria to search for
lr1 = Sheets("exempt").Cells(Rows.Count, "A").End(xlUp).Row
Set MyVals = Sheets("exempt").Range("A1:A" & lr1)

Set SrchRng = Selection
lr2 = SrchRng.Rows.Count

For i = lr2 To 1 Step -1
    For Each c In MyVals
        x = InStr(SrchRng(i), c)
        If x > 0 Then
            SrchRng(i).EntireRow.Delete
            Exit For
        End If
    Next c
Next i
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,213,491
Messages
6,113,963
Members
448,536
Latest member
CantExcel123

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top