Looped Find and Array Doesn't Find

[sbitaxi]

Hi everyone/anyone!

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

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 Worksheet
Dim DestSh As Object
Dim Last As Long


Set SourceSh = ActiveSheet
Worksheets.Add
Set DestSh = ActiveSheet
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

 

[Dave Peterson]

How about:

Option Explicit
Sub MoveFind()

Dim FoundCell As Range
Dim FndList As Variant
Dim SourceSh As Worksheet
Dim DestSh As Object
Dim oRow As Long
Dim Thing As Variant
Dim RowToDelete As Long

Set SourceSh = ActiveSheet
Set DestSh = Worksheets.Add
oRow = 1

FndList = Array("&", " or ", " and ", "ltd.", "employee group", "deceased")

With SourceSh
For Each Thing In FndList
Do
Set FoundCell = .Cells.Find(What:=Thing, _
After:=.Cells(.Cells.Count), _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If FoundCell Is Nothing Then
Exit Do 'stop looking for that thing and start looking
'for the next thing
Else
RowToDelete = FoundCell.Row
FoundCell.EntireRow.Cut _
Destination:=DestSh.Cells(oRow, "A")
.Rows(RowToDelete).Delete
oRow = oRow + 1
End If
Loop
Next Thing
End With
End Sub

 

[sbitaxi]

How about:

Option Explicit
Sub MoveFind()

    Dim FoundCell As Range
    Dim FndList As Variant
    Dim SourceSh As Worksheet
    Dim DestSh As Object
    Dim oRow As Long
    Dim Thing As Variant
    Dim RowToDelete As Long

    Set SourceSh = ActiveSheet
    Set DestSh = Worksheets.Add
    oRow = 1

    FndList = Array("&", " or ", " and ", "ltd.", "employee group","deceased")

    With SourceSh
        For Each Thing In FndList
            Do
              Set FoundCell = .Cells.Find(What:=Thing, _
                                After:=..Cells(.Cells.Count), _
                                LookIn:=xlFormulas, _
                                LookAt:=xlPart, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlNext, _
                                MatchCase:=False)
                If FoundCell Is Nothing Then
                   Exit Do 'stop looking for that thing and start looking
                           'for the next thing
                Else
                    RowToDelete = FoundCell.Row
                    FoundCell.EntireRow.Cut _
                        Destination:=DestSh.Cells(oRow, "A")
                    .Rows(RowToDelete).Delete
                    oRow = oRow + 1
                End If
            Loop
        Next Thing
    End With
End Sub

Dave:

That is much better than the solution I came up with. So much to
learn. Thanks Dave, this is great.


Steven