find multiple values code tweak

[ToddEZ]

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

 

[Bernie Deitrick]

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]

Bernie Rulz!

It works perfectly! Can you refer me to any good reading on arrays and
looping. ...this seems to be my weakness.

 

[Bernie Deitrick]

Todd,

My standard reply is pick any book by John Walkenbach in his "Excel XXXX Power Programming with VBA"
series. Great books - well written, and comprehensive. Amazon has a full offering of his available
books....

HTH,
Bernie
MS Excel MVP

 

[Bernie Deitrick]

Todd,

I also overlooked a flaw in your code:

You are missing these two lines:
Set rngFound = rngToSearch.FindNext(rngFound)
If Not rngFound Is Nothing And rngFound.Address <> strFirstAddressThen

which should be placed right before this part

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

Otherwise, you are adding the rngFound range object from the first "find" twice....

HTH,
Bernie
MS Excel MVP

 

[Alan Beban]

. . .Can you refer me to any good reading on arrays and
looping. ...this seems to be my weakness.

http://www.cpearson.com/excel/PassingAndReturningArrays.htm

You might usefully try the above link to Chip Pearson's site. He has a
number of pages on Arrays; you can see his topic index at

http://www.cpearson.com/excel/topic.aspx

Alan Beban