Deleting Row Based on Cell Content

[madhuchelliah]

Hey Guys, Please check code below. This code will delete entire row if it find the given word. I want to change this code to give more words criteria instead of one word. So that i no need to repeat the code again and again to delete the rows. Thank you.

Sub DelWords()
Dim SrchRng As Range, Cel As Range
Set SrchRng = Range("A1:A1000")
For Each Cel In SrchRng
    If InStr(1, Cel.Value, "John") > 0 Then
        Cel.EntireRow.Delete
    End If
Next Cel
End Sub

 

[offthelip]

you can exand it by the following as many times as you like:

If (InStr(1, Cel.Value, "John") > 0) or (InStr(1, Cel.value, "Harry") > 0) Then

 

[Fluff]

When deleting rows, it's always better to work up, rather than down.
Try this

Sub DelWords()
   Dim Cnt  As Long
   Dim Wrds As Variant
   Dim wrd As Variant
   
   Wrds = Array("[COLOR=#ff0000]John[/COLOR]", "[COLOR=#ff0000]Jane[/COLOR]", "[COLOR=#ff0000]Fluff[/COLOR]")
   
   For Cnt = 1000 To 1 Step -1
      For Each wrd In Wrds
       If InStr(1, Range("A" & Cnt).Value, wrd, vbTextCompare) > 0 Then
           Rows(Cnt).EntireRow.Delete
       End If
      Next wrd
   Next Cnt
End Sub

Change the values in red to match the words you're looking for. You can add more in the same style

 

[Rick Rothstein]

Hey Guys, Please check code below. This code will delete entire row if it find the given word. I want to change this code to give more words criteria instead of one word. So that i no need to repeat the code again and again to delete the rows. Thank you.

Sub DelWords()
Dim SrchRng As Range, Cel As Range
Set SrchRng = Range("A1:A1000")
For Each Cel In SrchRng
    If InStr(1, Cel.Value, "John") > 0 Then
        Cel.EntireRow.Delete
    End If
Next Cel
End Sub

Your loop will not work correctly if two adjacent cells in the search range both have the search word in them (removing the top cell's row moves the next cell up and the loop will then skip over it when the loop iterates. When you delete, you must iterate from the bottom cell upward to avoid this problem. That means you cannot use the For Each loop as it iterates from the top cell down. Give this a try instead (note that I added how to do multiple names to the code as well)...

Sub DelWords()
  Dim Rw As Long, SrchRng As Range
  Set SrchRng = Range("A1:A1000")
  For Rw = 1000 To 1 Step -1
    If InStr(1, Cells(Rw, "A").Value, "John") > 0 Or _
       InStr(1, Cells(Rw, "A").Value, "Harry") > 0 Or _
       InStr(1, Cells(Rw, "A").Value, "Mary") Then
      Rows(Rw).Delete
    End If
  Next
End Sub

 

[madhuchelliah]

Thank you all. You guys are awesome!!!!!!!!

 

[Fluff]

Glad we could help & thanks for the feedback