Home |
Search |
Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
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" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
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 "ToddEZ" wrote in message ... 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" wrote: 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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
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 "ToddEZ" wrote in message ... 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" wrote: 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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
find multiple values code tweak
ToddEZ wrote:
. . .Can you refer me to any good reading on arrays and looping. ...this seems to be my weakness. http://www.cpearson.com/excel/Passin...ningArrays.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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Need someone to help tweak a code | Excel Discussion (Misc queries) | |||
Code Tweak | Excel Programming | |||
Newby Needs minor tweak on this VBA Macro code for Excel | Excel Programming | |||
excel code tweak for outlook - confusing | Excel Programming | |||
Need final code tweak | Excel Programming |