On Jul 22, 11:35*am, Dave Peterson wrote:
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 Peterson

Dave:

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


Steven