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
wrote:
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