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

You have a Do Loop without a way out. What do you want to do? Find all instances of the values, or
just the first?

HTH,
Bernie
MS Excel MVP


wrote in message
...
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

Try something like this, if you want to delete rows: it is always better to sort prior to row
deletion, even compared to deleting a union. This assumes the values you are looking for are in
column H....

Sub DeleteAllInstancesOfCertainValues()
Dim myRow As Long
Dim Values As Variant
Dim myVal As Variant
Dim mySrcRange As Range

Set mySrcRange = Range("H:H")

Values = Array("TributeCardRecipient","Tribute","NotApplica ble")

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

For Each myVal In Values
myRow = Cells(Rows.Count, mySrcRange.Column).End(xlUp).Row
mySrcRange.Offset(0, 1).EntireColumn.Insert
mySrcRange.Offset(0, 1).Cells(1, 1).Value = "Flag"
mySrcRange.Offset(0, 1).Cells(2, 1).Resize(myRow - 1, 1).FormulaR1C1 = _
"=IF(RC[-1]=""" & myVal & """,""Delete"","""")"
Cells.Sort key1:=mySrcRange.Offset(0, 1).Cells(1, 2), order1:=xlDescending, Header:=xlYes
mySrcRange.Offset(0, 1).AutoFilter Field:=1, Criteria1:="Delete"
mySrcRange.Offset(0, 1).Range("A2:A" &
Rows.Count).SpecialCells(xlCellTypeVisible).Entire Row.Delete
mySrcRange.Offset(0, 1).EntireColumn.Delete
Next myVal

With Application
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub


HTH,
Bernie
MS Excel MVP


"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
You have a Do Loop without a way out. What do you want to do? Find all instances of the values,
or just the first?

HTH,
Bernie
MS Excel MVP


wrote in message
...
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

Hi Bernie:

Thank you, I replaced that with the following code:

SrcEntRng.AutoFilter Field:=1,
Criteria1:="=TributeCardRecipient", Operator:=xlOr, _
Criteria2:="=Tribute"
Set Rng2 =
SrcRng.Columns(1).SpecialCells(xlVisible).EntireRo w
Rng2.Delete
SrcWS.AutoFilterMode = False

More efficient than going through each idividual row, and I should
have thought of it before.


S

On Aug 19, 12:43*pm, "Bernie Deitrick" <deitbe @ consumer dot org
wrote:
You have a Do Loop without a way out. *What do you want to do? Find all instances of the values, or
just the first?

HTH,
Bernie
MS Excel MVP

wrote in message

...



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- Hide quoted text -

- Show quoted text -

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