View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.misc
Cue Cue is offline
external usenet poster
 
Posts: 47
Default 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