Delete Row Based on cell Value with wildcard

[minxka]

Hey there!

I'm struggling with some code I found on another site (here:How to remove rows based on cell value in Excel?)

The code works when I specify a specific value but I'd like to use cell.value like "*something*"

For some reason this code doesn't seem to work...

Sub Delete_Rows()
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A6:A20"), ActiveSheet.UsedRange)
For Each cell In rng
If cell.Value Like "*word I want to match*" _
Then
If del Is Nothing Then
Set del = cell
Else: Set del = Union(del, cell)
End If
End If
Next cell
On Error Resume Next
del.EntireRow.Delete
End Sub

Any help much appreciated!

Thanks,

Claire

 

[stemar]

Your code worked for me, but Like comparisons are case sensitive. Could that be the problem?

 

[minxka]

Hey thanks for the quick reply! I changed everything to lowercase in the column and tested on a small area.. for a moment I thought it worked but when I increased the range of cells it has gone back to doing nothing...

Does it matter if there are spaces? As something things would be "a short phrase" whereas some are just "word"

Also the data is held within a table - should it make a difference?

Thanks again for your help!

Claire

 

[stemar]

The table's the problem. It seems EntireRow.Delete doesn't work with them. If you don't need the table, your code should be fine. If you do, this is crude, but works. Of course, it only deletes the rows within the table.

Sub Delete_Table_Rows()

Dim obList As ListObject
Dim obRow As ListRow

Dim lCount As Long
Dim lIndex As Long
    Set obList = ActiveSheet.ListObjects(1)
    On Error GoTo Finished
    For Each obRow In obList.ListRows
        If obRow.Range.Cells(1, 1) Like "*to test*" Then obRow.Delete
    Next obRow

Finished:

End Sub

Deleting rows using For Each...Next causes an error when the loop runs out of rows. Someone a bit cleverer than me will be along in a minte to tell us why, with a bit of luck.

I've got work to do, so I'll leave you to take the code above and do something a bit more elegant!

 

[NumberWang]

Hey all,

I was able to get OP's code to work for a single sheet, but for the life of me I can't get it to work for multiple sheets. I've googled a bunch of "macro multiple worksheets" codes such as the following. And although I don't get errors, I haven't found anything that actually applies the macro to the entire workbook, whether I have multiple sheets selected or not.

[FONT=Tahoma][COLOR=#00007F]Sub[/COLOR] name()
    [COLOR=#00007F]Dim[/COLOR] ws [COLOR=#00007F]As[/COLOR] Worksheet
        [COLOR=#00007F]For[/COLOR] [COLOR=#00007F]Each[/COLOR] ws [COLOR=#00007F]In[/COLOR] ActiveWorkbook.Worksheets
            [COLOR=#007F00]'  Insert Code[/COLOR]
         N[COLOR=#00007F]ext[/COLOR] ws
[COLOR=#00007F]End[/COLOR] [COLOR=#00007F]Sub[/COLOR][/FONT]

 

[stemar]

Hey all,

I was able to get OP's code to work for a single sheet, but for the life of me I can't get it to work for multiple sheets. I've googled a bunch of "macro multiple worksheets" codes such as the following. And although I don't get errors, I haven't found anything that actually applies the macro to the entire workbook, whether I have multiple sheets selected or not.

[FONT=Tahoma][COLOR=#00007F]Sub[/COLOR] name()
    [COLOR=#00007F]Dim[/COLOR] ws [COLOR=#00007F]As[/COLOR] Worksheet
        [COLOR=#00007F]For[/COLOR] [COLOR=#00007F]Each[/COLOR] ws [COLOR=#00007F]In[/COLOR] ActiveWorkbook.Worksheets
            [COLOR=#007F00]'  Insert Code[/COLOR]
         N[COLOR=#00007F]ext[/COLOR] ws
[COLOR=#00007F]End[/COLOR] [COLOR=#00007F]Sub[/COLOR][/FONT]

Well, this is a blast from the past

You may find it works if you select each sheet. Insert ws.select after the For Each... line.

 

[NumberWang]

Well, this is a blast from the past

You may find it works if you select each sheet. Insert ws.select after the For Each... line.

Hey stemar, thanks for chiming in again after 3 years!

No dice though. I tried inserting ws.select after each of the For Each lines and then after both of them. It only worked on the individual worksheet I was last on, and deselected all the rest. Any thoughts?

Sub DeleteRows()
    Dim ws As Worksheet
        For Each ws In ActiveWorkbook.Worksheets
        ws.Select
            Dim rng As Range, cell As Range, del As Range
            Set rng = Intersect(Range("A1:A200"), ActiveSheet.UsedRange)
            For Each cell In rng
            '~~~I tried putting ws.select here too 
            If cell.Value Like "*30:00*" _
            Then
            If del Is Nothing Then
            Set del = cell
            Else: Set del = Union(del, cell)
            End If
            End If
            Next cell
            On Error Resume Next
            del.EntireRow.Delete
         Next ws
End Sub

 

[stemar]

OK, I've had a nose round your code and I think the main problem is the line

Dim rng As Range, cell As Range, del As Range

Dim is only used by the compiler, I don't think you can use it to reset values. To my mind it's best to declare all your variables at the beginning of your code, it makes it a lot easier to keep track of things - especially if you're trying to sort out a sub that's several screens long! You also have to set del = nothing at the beginning of each For Each ws... loop.

This works for me:

Sub DeleteRows()
    Dim ws As Worksheet
    Dim rng As Range, cell As Range, del As Range
        For Each ws In ActiveWorkbook.Worksheets
        ws.Activate
            
            Set rng = Intersect(ws.Range("A1:A200"), ws.UsedRange)
            Set del = Nothing
            For Each cell In rng
                If cell.Value Like "*30:00*" Then
                    If del Is Nothing Then
                        Set del = cell
                    Else: Set del = Union(del, cell)
                    
                    End If
                End If
            Next cell
            
            If Not del Is Nothing Then del.EntireRow.Delete
         Next ws
End Sub

However, it deletes only the rows where col A contains 30:00. If that's really all you want to accomplich you don't need to faff around with unions. This works just as well:

Sub DeleteRows()

Dim ws As Worksheet
Dim rng As Range, cell As Range, del As Range

        For Each ws In ActiveWorkbook.Worksheets
            ws.Select
            Set del = Nothing
            Set rng = Intersect(Range("A1:A200"), ActiveSheet.UsedRange)
            For Each cell In rng
                If cell.Value Like "*30:00*" Then cell.EntireRow.Delete
            Next cell
         Next ws
End Sub

Hope this helps!

 

[NumberWang]

Stemar, thanks a lot! That worked perfect.