Try this...

Sub test()
Call DeleteBlanks
Call DeleteUnwanted("This")

End Sub

Sub DeleteUnwanted(ByVal DeleteWord As String)
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngCurrent As Range
Dim rngDelete As Range
Dim rngFirst As Range

Set wks = Sheets("Sheet1")
Set rngToSearch = wks.Range("A1:A65000")

Set rngCurrent = rngToSearch.Find(DeleteWord)
If Not rngCurrent Is Nothing Then
Set rngDelete = rngCurrent
Set rngFirst = rngCurrent
Do
Set rngDelete = Union(rngCurrent, rngDelete)
Set rngCurrent = rngToSearch.FindNext(rngCurrent)
Loop Until rngCurrent.Address = rngFirst.Address
rngDelete.EntireRow.Delete
End If
End Sub

Sub DeleteBlanks()
Dim wks As Worksheet
Dim rngToSearch As Range
Dim rngDelete As Range

Set wks = Sheets("Sheet1")
Set rngToSearch = wks.Range("A1:A65000")

Set rngDelete = rngToSearch.SpecialCells(xlCellTypeBlanks)
rngDelete.EntireRow.Delete
End Sub

--
HTH...

Jim Thomlinson


"Petra" wrote:

I need to loop through an Excel spreadsheet from A1 through A65000 for
specific words and delete out the entire row containing that word. I also
need to delete out blank rows. An example is:

Range("A1").Select
Cells.Find(What:="Payee/", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,
MatchCase:= _
False, SearchFormat:=False).Activate
Rows("53:53").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Cells.Find(What:="Program d", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
Rows("43:43").Select
Selection.Delete Shift:=xlUp

Unfortunately, the cell references are not important, even though the macro
recorded my keystrokes. The important thing is to delete out the row that
contains these specific words and continue the process until the worksheet
does not contain any more of these words. Any help will be greatly
appreciated.

Thankyou.