Todd,

You need to set up an array of values you want to find, then loop through them. See the macro
below.

HTH,
Bernie
MS Excel MVP

Sub MoveStuff2()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String
Dim FindStr As Variant
Dim i As Integer

Set rngPaste = Sheets("completed").Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)

FindStr = Array("Deal", "No Deal", "Todd Rulz")

For i = LBound(FindStr) To UBound(FindStr)
Set rngToSearch = ActiveSheet.Columns("A")
Set rngFound = rngToSearch.Find(What:=FindStr(i), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)

If rngFound Is Nothing Then GoTo NotFound

If rngFoundAll Is Nothing Then
Set rngFoundAll = rngFound
Else
Set rngFoundAll = Union(rngFoundAll, rngFound)
End If

strFirstAddress = rngFound.Address

Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

NotFound:
Next i

If rngFoundAll Is Nothing Then
MsgBox "None Found!"
Exit Sub
End If

rngFoundAll.EntireRow.Copy Destination:=rngPaste
rngFoundAll.EntireRow.Delete 'Optional to Delete

End Sub


"ToddEZ" wrote in message
...
Hello,

How do I tweak the following code to cut and paste all rows with "deal" or
"no deal" in column A rather than "S". Here is my code.

Thanks

Sub MoveStuff()
Dim rngToSearch As Range
Dim rngFound As Range
Dim rngFoundAll As Range
Dim rngPaste As Range
Dim strFirstAddress As String

Set rngPaste = Sheets("completed").Cells(Rows.Count, _
"A").End(xlUp).Offset(1, 0)
Set rngToSearch = ActiveSheet.Columns("A")
Set rngFound = rngToSearch.Find(What:="S", _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
MatchCase:=False)
If rngFound Is Nothing Then
MsgBox "There are no items to move."
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress

rngFoundAll.EntireRow.Copy Destination:=rngPaste
rngFoundAll.EntireRow.Delete 'Optional to Delete
End If
End Sub