There are a couple of issues in your code. The biggest thing is your loop has
not way out. Additioanlly you have not speicfied enough parameters in your
find which can cause problems... Try this...

Sub test()
Dim SrcRng As Range
Dim RcdType As Variant
Dim Thing As Variant

Set SrcRng = Cells
RcdType = Array("TributeCardRecipient", "Tribute", "NotApplicable")
For Each Thing In RcdType
Call FoundCells(Thing, SrcRng, FoundCell)
Next Thing
If Not FoundCell Is Nothing Then FoundCell.EntireRow.Select 'Change to delete
End Sub

Public Sub FoundCells(ByVal ToFind As String, ByVal SourceRange As Range, _
Optional ByRef FoundRange As Range)
Dim rngFound As Range
Dim strFirstAddress As String

Set rngFound = SourceRange.Find(What:=ToFind, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
MatchCase:=False)
If Not rngFound Is Nothing Then
If FoundRange Is Nothing Then
Set FoundRange = rngFound
Else
Set FoundRange = Union(FoundRange, rngFound)
End If
strFirstAddress = rngFound.Address
Do
Set FoundRange = Union(FoundRange, rngFound)
Set rngFound = SourceRange.FindNext(rngFound)
Loop Until strFirstAddress = rngFound.Address
End If
End Sub
--
HTH...

Jim Thomlinson


" wrote:

The following code bogs down at the "If Not FoundCell" statement and I
have no idea why. I was trying to make the code more efficient by
assigning all rows that I was deleting to Rng and it worked for all
other statements but this one.

When I break and step into the code, it gives me a 1004 error for the
Set Rng = Union step.

Any idea how to make this work?

RcdType = Array("TributeCardRecipient") ' "Tribute") ',
"NotApplicable")
For Each Thing In RcdType
Do
Set FoundCell = SrcRng.Find(What:=Thing)

If Not FoundCell Is Nothing Then
If Rng Is Nothing Then
Set Rng = Rows(FoundCell.Row & ":"
& FoundCell.Row)
Else: Set Rng = Union(Rng,
Rows(FoundCell.Row & ":" _
& FoundCell.Row))
End If
End If
Loop
Next