find and delete again

[rhino4eva]

Sheets("Sheet1").UsedRange
Dim Rng1 As Range
For Each Rng1 In Range("Z:Z").SpecialCells(xlBlanks).Areas
Intersect(Rng1.EntireRow, Range("A:BT")).Delete shift:=xlUp
Next Rng1

ok so I have used this code many times but need to modify it a little

.SpecialCells(xlBlanks). gets rid of blanks

I would like to repeat the exercise but I would like to delete the entirerow if it finds the word "Vitamin D" and "PSA"

 

[Fluff]

How about

Sub rhino4eva()
   Dim Rng As Range
   
   With Range("Z:Z")
      .Replace "Vitamin D", "", xlWhole, , False, , False, False
      .Replace "PSA", "", xlWhole, , False, , False, False
      For Each Rng In .SpecialCells(xlBlanks).Areas
         Intersect(Rng.EntireRow, Range("A:BT")).Delete xlShiftUp
      Next Rng
   End With
End Sub

 

[rhino4eva]

that's brill ....it works a treat & I can even expand on it

 

[Fluff]

You're welcome & thanks for the feedback