Looped Find and Array Doesn't Find

Tech-Archive recommends: Fix windows errors by optimizing your registry

Hi everyone/anyone!

The following code is supposed to search through a work*** for a
series of values, cut the row with the found value and paste it into a
new work***. I want it to loop through the array Fnd and go to the
Next instance when it fails to find that value in the work***.

Previous code failed with an Error 91 when it did not find the value.
A search pulled up code that used FoundCell. It worked once, but I'm
not sure why it doesn't work now (or why it worked in the first
place). Right now, FoundCell becomes a value of 1. How do I get
FoundCell to equal the results of Cell.Find(What:=Thing...?

Sub MoveFind()
Dim FoundCell As Range
Dim Fnd As Variant
Dim SourceSh As Work***
Dim DestSh As Object
Dim Last As Long


Set SourceSh = Active***
Worksheets.Add
Set DestSh = Active***
SourceSh.Activate
' Range("A1").Select
Fnd = Array("&", " or ", " and ","ltd.","employee
group","deceased")
For Each Thing In Fnd
Do
Set FoundCell = Cells.Find(What:=Thing, After:=ActiveCell,
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
SearchDirection:=xlNext, MatchCase:=False)
If FoundCell Is Nothing Then
GoTo 1
' give yourself some feedback
Else
Rows(ActiveCell.Row).Select
Selection.Cut
DestSh.Activate
Range("A2").Select
Last = LastRow(DestSh)
Rows(Last + 1).Select
DestSh.Paste
SourceSh.Activate
Selection.Delete
End If
Loop
1 Next Thing
End Sub
.

Quantcast