|
Copy Row If Value is Between
Hello to All,
Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
Try this
If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then Mike "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
I changed your if statement
If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then If it were my code, I'd probably add this Dim aWS as worksheet set aWS = ActiveSheet .... If aWS.Range("D" & CStr(LSearchRow)).Value = 199.99 And _ aWS.Range("D" & CStr(LSearchRow)).Value <= 399.99 Then .... -- HTH, Barb Reinhardt If this post was helpful to you, please click YES below. "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
Hi,
Looking generally at the code it's too complicated with all the selecting. I'd simplify it to this Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & LSearchRow).Value = 199.99 And _ Range("D" & LSearchRow).Value <= 399.99 Then Rows(LSearchRow).Copy Sheets("0-99").Rows(LCopyToRow).PasteSpecial LCopyToRow = LCopyToRow + 1 End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Mike "Mike H" wrote: Try this If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then Mike "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
Just to add...
VBA is pretty forgiving. You don't need the cstr() stuff. And you don't need to specify the starting row and ending row if you're range is a single row. It's better to use "As long" instead of "as integer". Integers may not be able to hold the row numbers for your data. And if you copy|paste, you can specify the topleft corner of the pasted range. You don't need to resize the destination range. (I did change your copy|paste special, to a copy (with destination).) Option Explicit Sub SearchForString() Dim LSearchRow As Long Dim LCopyToRow As Long On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & LSearchRow).Value) 0 If Range("D" & LSearchRow).Value = 199.99 _ And Range("D" & LSearchRow).Value <= 399.99 Then Rows(LSearchRow).Copy _ Destination:=Sheets("0-99").Range("A" & LCopyToRow) LCopyToRow = LCopyToRow + 1 End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub ===== Another way to approach this would be to apply data|filter|autofilter to that range in column D. Then filter to show the values between your two endpoints. Then copy the visible cells to the other worksheet. You may want to experiment when you have time. Cue wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue -- Dave Peterson |
Copy Row If Value is Between
My preference would probably be to simplify something like this...
Sub SearchForString() Dim X As Long Dim MatchedRows As Range Const LSearchRow As Long = 4 Const LCopyToRow As Long = 2 With Worksheets("Sheet1") For X = LSearchRow To LSearchRow + .Cells(LSearchRow, "D"). _ CurrentRegion.Rows.Count - 1 If .Cells(X, "D").Value = 199.99 And _ .Cells(X, "D").Value <= 399.99 Then If MatchedRows Is Nothing Then Set MatchedRows = .Rows(X) Else Set MatchedRows = Union(MatchedRows, .Rows(X)) End If End If Next End With If MatchedRows Is Nothing Then MsgBox "No matching data was found." Else MatchedRows.Copy Worksheets("0-99").Rows(LCopyToRow) MsgBox "All matching data has been copied." End If End Sub I don't anticipate any errors with this construction, so I removed the error check (the OP can add it back if he so desires). I also added a "source" worksheet via a With/End With block as I think it is always a good idea to qualify references. -- Rick (MVP - Excel) "Mike H" wrote in message ... Hi, Looking generally at the code it's too complicated with all the selecting. I'd simplify it to this Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & LSearchRow).Value = 199.99 And _ Range("D" & LSearchRow).Value <= 399.99 Then Rows(LSearchRow).Copy Sheets("0-99").Rows(LCopyToRow).PasteSpecial LCopyToRow = LCopyToRow + 1 End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Mike "Mike H" wrote: Try this If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then Mike "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
Thank you all for repling. I will try each suggestions and reply to each one
afterwards. Thanks again everyone! -- Cue "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
Thank you Mike!
-- Cue "Mike H" wrote: Try this If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then Mike "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
This is better! Thank you.
-- Cue "Mike H" wrote: Hi, Looking generally at the code it's too complicated with all the selecting. I'd simplify it to this Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & LSearchRow).Value = 199.99 And _ Range("D" & LSearchRow).Value <= 399.99 Then Rows(LSearchRow).Copy Sheets("0-99").Rows(LCopyToRow).PasteSpecial LCopyToRow = LCopyToRow + 1 End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Mike "Mike H" wrote: Try this If Range("D" & CStr(LSearchRow)).Value = 199.99 And _ Range("D" & CStr(LSearchRow)).Value <= 399.99 Then Mike "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
Copy Row If Value is Between
All of your suggestions were a success!
Thank you to all! -- Cue "Cue" wrote: Thank you all for repling. I will try each suggestions and reply to each one afterwards. Thanks again everyone! -- Cue "Cue" wrote: Hello to All, Please help. I copied a VBA Code from a site that is almost perfect for what I want it to do. The only issue is I want it to copy a row if the $ value of column D is between two $ amounts. For this line, €˜If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then, I get an error box and it selects €˜to. Can somebody show me whats wrong so I can achieve my goal? Here is the code: Sub SearchForString() Dim LSearchRow As Integer Dim LCopyToRow As Integer On Error GoTo Err_Execute LSearchRow = 4 LCopyToRow = 2 While Len(Range("D" & CStr(LSearchRow)).Value) 0 If Range("D" & CStr(LSearchRow)).Value is 199.99 to 399.99 Then Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select Selection.Copy Sheets("0-99").Select Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select ActiveSheet.Paste LCopyToRow = LCopyToRow + 1 Sheets("MultAdjDaily").Select End If LSearchRow = LSearchRow + 1 Wend Application.CutCopyMode = False Range("A3").Select MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub Please help. -- Cue |
| All times are GMT +1. The time now is 12:16 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com