PDA

View Full Version : Solved: Copy rows with todays dates



maninjapan
12-17-2009, 09:10 AM
I have a sheet of spread trades with a start date in column G. I would like to copy any spreads that fall within 7 days from today or was less than 7 days ago. So I need to select the row with the date and the row below it. heres a sample of what I have, any pointers would be much appreciated.

Thank you

maninjapan
12-17-2009, 09:18 AM
Am I able to utilize the following example?


Sub MoveDataToSheet(2)
'Determine how many rows in Sheet1
lastListRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Loop through rows
For myItems = 1 To lastListRow
'Determine next empty row in Sheet2
destRow = Sheets(2).Range("A" & Rows.Count).End(xlUp).Row + 1


If ... DATE STATEMENT HERE....
Rows(myItems).EntireRow.Copy _
Destination:=Sheets(2).Range("A" & destRow)
'Loop
Next
End Sub

mbarron
12-17-2009, 12:02 PM
Try this:
Sub moveEm()
Dim i As Long, lRow As Long, curSht As Worksheet, dstSht As Worksheet
Set curSht = Worksheets(1)
Set dstSht = Worksheets(2)
lRow = curSht.Range("b" & Rows.Count).End(xlUp).Row

curSht.Range("1:2").Copy _
Destination:=dstSht.Range("a1")
For i = 3 To lRow Step 2
If curSht.Range("G" & i) >= Date - 7 Then
curSht.Range("a" & i & ":a" & i + 1).EntireRow.Copy _
Destination:=dstSht.Range("a" & dstSht.Range("b1").End(xlDown).Row + 1)
End If
Next


End Sub

maninjapan
12-17-2009, 12:28 PM
Thanks mbarron, added the second part to the if statement and it works a charm




Sub moveEm()
Dim i As Long, lRow As Long, curSht As Worksheet, dstSht As Worksheet
Set curSht = Worksheets(1)
Set dstSht = Worksheets(2)
lRow = curSht.Range("b" & Rows.Count).End(xlUp).Row

curSht.Range("1:2").Copy _
Destination:=dstSht.Range("a1")
For i = 3 To lRow Step 2
If curSht.Range("G" & i) >= Date - 7 And curSht.Range("G" & i) <= Date + 7 Then
curSht.Range("a" & i & ":a" & i + 1).EntireRow.Copy _
Destination:=dstSht.Range("a" & dstSht.Range("b1").End(xlDown).Row + 1)
End If
Next


End Sub