Copy Row If Value is Between

[Cue]

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 what’s
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.

 

[Mike H]

Try this

If Range("D" & CStr(LSearchRow)).Value >= 199.99 And _
Range("D" & CStr(LSearchRow)).Value <= 399.99 Then

Mike

 

[Barb Reinhardt]

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

....

 

[Mike H]

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

 

[Dave Peterson]

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.

 

[Rick Rothstein]

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.

 

[Cue]

Thank you all for repling. I will try each suggestions and reply to each one
afterwards.

Thanks again everyone!

 

[Cue]

Thank you Mike!
--
Cue

Try this

If Range("D" & CStr(LSearchRow)).Value >= 199.99 And _
Range("D" & CStr(LSearchRow)).Value <= 399.99 Then

Mike

 

[Cue]

This is better! Thank you.
--
Cue

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

 

[Cue]

All of your suggestions were a success!
Thank you to all!