find multiple values code tweak


T

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
 
Ad

Advertisements

B

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
 
T

ToddEZ

Bernie Rulz!

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

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
 
B

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
 
Ad

Advertisements

Ad

Advertisements


Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top