VBA - delete entire row based on values listed in a different sheet

[Kennypowers55]

I have a big dataset that I'd like to clean up.
I want to do it by having a list in sheet2 of words, that is used to delete entire rows in sheet1.

I found one thread that answers this only if it's an exact match. Where the cell could only contain "lean" to be deleted.
I want it to delete based on a word in a sentence or mix of words.
For example delete a row containing a cell with the sentence "What is lean", based on having "lean" in the list in sheet2.

Hilfe hilfe

The other thread

VBA - Delete entire row based on a list of values on a separate sheet

Hello, I copy and paste a table "Customer" from a source to Sheet1 in excel. I would like delete the entire row in the "Customer" table if it contains/matches values from a list in Sheet2. I wonder if anyone has a VBA code that enable me to automate that process. Thank you!

www.mrexcel.com

The VBA Code:

Code:
Sub delrows()
Dim d As Object, e, rws&, cls&, i&, j&
Set d = CreateObject("scripting.dictionary")
For Each e In Sheets("sheet2").Range("A1").CurrentRegion
d(e.Value) = 1
Next e
Sheets("sheet1").Activate
rws = Cells.Find("*", after:=[a1], searchorder:=xlByRows, _
searchdirection:=xlPrevious).Row
cls = Cells.Find("*", after:=[a1], searchorder:=xlByColumns, _
searchdirection:=xlPrevious).Column
For i = rws To 1 Step -1
For j = 1 To cls
If d(Range("A1").Resize(rws, cls)(i, j).Value) = 1 Then _
Cells.Rows(i).Delete: Exit For
Next j, i
End Sub

 

[SQUIDD]

Hi

Can you just confirm

On sheet 2, where are your words located.

Do you also want entire rows to be deleted, if any of the list is detected in sheet 2.

I think, just incase you want to tackle it yourself, using INSTR will work.

Dave

 

[Kennypowers55]

Hi

Can you just confirm

On sheet 2, where are your words located.

Do you also want entire rows to be deleted, if any of the list is detected in sheet 2.

I think, just incase you want to tackle it yourself, using INSTR will work.

Dave

The list is in sheet2 from A1 and down to A90 . Seems to be including everything new I write into new cells, when i run the code.

Yes, the entire row deleted in sheet1 if it contains a word from the list in sheet2.

I'm a noob at this, don't know what INSTR means

 

[SQUIDD]

Hi Kenny, well welcome to the forum.

please see code below that i think should work for you.

please test this on a copy of your data.

This deletes all rows on sheet1, if any of the words from your list on sheet 2 is found in column A in your sheet 1.

However, im not sure now if you wanted to delete the rows if it was found in any column?

Dave

Sub DELETE_ROWS()
    For A = Worksheets("SHEET1").Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        For B = 1 To Worksheets("SHEET2").Range("A" & Rows.Count).End(xlUp).Row
            If InStr(1, Worksheets("SHEET1").Cells(A, 1), Worksheets("SHEET2").Cells(B, 1)) Then Worksheets("SHEET1").Rows(B).EntireRow.Delete
        Next B
    Next A
End Sub

 

[Kennypowers55]

Hi Kenny, well welcome to the forum.

please see code below that i think should work for you.

please test this on a copy of your data.

This deletes all rows on sheet1, if any of the words from your list on sheet 2 is found in column A in your sheet 1.

However, im not sure now if you wanted to delete the rows if it was found in any column?

Dave

Sub DELETE_ROWS()
    For A = Worksheets("SHEET1").Range("A" & Rows.Count).End(xlUp).Row To 2 Step -1
        For B = 1 To Worksheets("SHEET2").Range("A" & Rows.Count).End(xlUp).Row
            If InStr(1, Worksheets("SHEET1").Cells(A, 1), Worksheets("SHEET2").Cells(B, 1)) Then Worksheets("SHEET1").Rows(B).EntireRow.Delete
        Next B
    Next A
End Sub

Thanks Dave! But I tested the code, knowing that only 5 rows contained one word. It deleted all rows but the first

Searching in column A is fine, if it's easier to code, than searching in entire sheet1. But if it's easy, entire sheet 1 is optimal

 

[Kennypowers55]

Thanks Dave! But I tested the code, knowing that only 5 rows contained one word. It deleted all rows but the first

Searching in column A is fine, if it's easier to code, than searching in entire sheet1. But if it's easy, entire sheet 1 is optimal

To be more accurate: it deleted 1500 rows instead of deleting the 5 rows containing the word

 

[SQUIDD]

Hi

Yeah, sorry, my fault.

try this.I have also accounted for matching case.

But you can remove this part ucase()

Sub DELETE_ROWS()
Application.ScreenUpdating = False
    For A = Worksheets("SHEET1").Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        For B = 1 To Worksheets("SHEET2").Range("A" & Rows.Count).End(xlUp).Row
            If InStr(1, UCase(Worksheets("SHEET1").Cells(A, 1)), UCase(Worksheets("SHEET2").Cells(B, 1))) Then Worksheets("SHEET1").Rows(A).EntireRow.Delete
        Next B
    Next A
Application.ScreenUpdating = True
End Sub

 

[Kennypowers55]

Hi

Yeah, sorry, my fault.

try this.I have also accounted for matching case.

But you can remove this part ucase()

Sub DELETE_ROWS()
Application.ScreenUpdating = False
    For A = Worksheets("SHEET1").Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        For B = 1 To Worksheets("SHEET2").Range("A" & Rows.Count).End(xlUp).Row
            If InStr(1, UCase(Worksheets("SHEET1").Cells(A, 1)), UCase(Worksheets("SHEET2").Cells(B, 1))) Then Worksheets("SHEET1").Rows(A).EntireRow.Delete
        Next B
    Next A
Application.ScreenUpdating = True
End Sub

I can see that ucase() is used two places, but I wouldn't know exactly what to remove.

The new code also just removes all rows instead of the 5 rows containing a certain word

 

[Alex Blakenburg]

Is your list in Sheet2 in a table by any chance and does the table have blank rows in it ?
Working with Squidd's solution does the issue go away if you change it to this:

Sub DELETE_ROWS_Squidd_Mod()
Application.ScreenUpdating = False
    For A = Worksheets("SHEET1").Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
        For B = 1 To Worksheets("SHEET2").Range("A" & Rows.Count).End(xlUp).Row
            If Trim(Worksheets("SHEET2").Cells(B, 1)) <> "" Then
                If InStr(1, UCase(Worksheets("SHEET1").Cells(A, 1)), UCase(Worksheets("SHEET2").Cells(B, 1))) Then
                    Worksheets("SHEET1").Rows(A).EntireRow.Delete
                    Exit For
                End If
            End If
        Next B
    Next A
Application.ScreenUpdating = True
End Sub