Delete Rows When Word Is Found

[Dazzawm]

Hi I need a macro that will look in the column I select for a specific word that could be amongst other text then delete the entire row. Also I need it to delete any blank rows that are directly beneath until it finds the next cell with data in.

i.e it looks for the word 'Hello' (maybe amongst other text) in the active column which the first may be in C12 the next 6 rows in column C may be empty so those rows need to be deleted also until the next data is found and so on..

 

[Dazzawm]

I think repeat. This code will loop until you click cancel

Sub Daz()
Dim s As String, iCol As Long, LR As Long, i As Long
Dim r As Range, F As Boolean
iCol = ActiveCell.Column
s = "£"
Do While s <> ""
    s = LCase(InputBox("Enter word to look for"))
    If s = "" Then Exit Sub
    LR = Cells(Rows.Count, iCol).End(xlUp).Row
    For i = 1 To LR
        If LCase(Cells(i, iCol).Value) Like "*" & s & "*" Then
            If r Is Nothing Then
                Set r = Cells(i, iCol)
            Else
                Set r = Union(r, Cells(i, iCol))
            End If
            F = True
        ElseIf Cells(i, iCol).Value <> "" Then
            F = False
        Else
            If F Then
                If r Is Nothing Then
                    Set r = Cells(i, iCol)
                Else
                    Set r = Union(r, Cells(i, iCol))
                End If
            End If
        End If
    Next i
    If Not r Is Nothing Then r.EntireRow.Delete
    Set r = Nothing
    F = False
Loop
End Sub

Hi VoG, this works great where I highlight a column and when I enter a word in the input box and it appears anywhere in the cell it deletes the entire row. What I need now is it to do the opposite please. If I enter a word in the box it deletes all the rows that do not contain that word, which could be anywhere in the cell (and any case size). Is this possible please? Thanks.

 

[VoG]

Untested but I think this should work

Sub Daz2()
Dim s As String, iCol As Long, LR As Long, i As Long
Dim r As Range, F As Boolean
iCol = ActiveCell.Column
s = "£"
Do While s <> ""
    s = LCase(InputBox("Enter word to look for"))
    If s = "" Then Exit Sub
    LR = Cells(Rows.Count, iCol).End(xlUp).Row
    For i = 1 To LR
        If Not LCase(Cells(i, iCol).Value) Like "*" & s & "*" Then
            If r Is Nothing Then
                Set r = Cells(i, iCol)
            Else
                Set r = Union(r, Cells(i, iCol))
            End If
            F = True
        ElseIf Cells(i, iCol).Value <> "" Then
            F = False
        Else
            If F Then
                If r Is Nothing Then
                    Set r = Cells(i, iCol)
                Else
                    Set r = Union(r, Cells(i, iCol))
                End If
            End If
        End If
    Next i
    If Not r Is Nothing Then r.EntireRow.Delete
    Set r = Nothing
    F = False
Loop
End Sub

 

[Dazzawm]

Thanks VoG that works.

 

[Dazzawm]

A slight after thought. Could I put more than one word in the box at the same time, for example if I put 'Yes,No' it will delete all the other rows that don't contain either of these? If its virtually a whole rewrite of the code then don't worry about it, only if its not too much trouble. Thanks.

 

[VoG]

I think that you asked the same thing in Post #8. Not impossible but it would require a lot of re-writing and testing. If you really need this, please start a new thread.

 

[Dazzawm]

Ok thanks, I can get by using a combo of the 2 codes. I will start a new thread if I find I am using it a lot.