PDA

View Full Version : Conditional date copying



CatDaddy
02-09-2012, 11:27 AM
I have a worksheet where column A is populated by dates. I am trying to have the macro pull all of the dates that fall within a given month (then 3 months previous, 6 months previous, etc.) it works for all of the previous months and it works for the first month unless it happens to be the last month in column A. To account for that I added the following:

temp = InputBox("Enter date of first day of month to forecast (mm/dd/yyyy): ")
wbSrc.Sheets("Incoming").Activate
i = Range("A36000").End(xlUp).Row
'Dates of current month
sD = CDate(temp)
eD = DateSerial(Year(sD), Month(sD) + 1, 0)
eD = CDate(eD)
MsgBox (sD & vbCrLf & eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And cellD2 > eD Then
eR = count
ElseIf cellD1 <= eD And Range("A" & (count + 1)).Value = "" Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":A" & eR).Select
Selection.Copy
ThisWorkbook.Sheets(1).Activate
Range("M1").Select
ActiveSheet.Paste

The dates of current months work, and the whole code works if the date is not followed by an empty row but almost always with this report the date to forecast will be the last 20 or so rows of column A.

CatDaddy
02-09-2012, 12:10 PM
here is my complete code (month-3, month-6, month-9 and month-12 all pull correctly)

Sub pullData()
Dim wbSrc As Workbook
Dim wb As Workbook
Dim sD As Date, eD As Date, cellD1 As Date, cellD2, cellD3
Dim i As Long, count As Long, sR As Long, eR As Long
Dim temp As String
Set wbSrc = ActiveWorkbook
temp = InputBox("Enter date of first day of month to forecast (mm/dd/yyyy): ")
'temp = "2/1/2012"
wbSrc.Sheets("Incoming").Activate
i = Range("A36000").End(xlUp).Row
'Dates of current month
sD = CDate(temp)
eD = DateSerial(Year(sD), Month(sD) + 1, 0)
eD = CDate(eD)
MsgBox (sD & vbCrLf & eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And cellD2 > eD Then
eR = count
ElseIf cellD1 <= eD And Range("A" & (count + 1)).Value = "" Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":A" & eR).Select
Selection.Copy
ThisWorkbook.Sheets(1).Activate
Range("M1").Select
ActiveSheet.Paste
wbSrc.Sheets("Incoming").Activate
'Dates of month - 3
sD = DateSerial(Year(sD), Month(sD) - 3, 1)
eD = DateSerial(Year(eD), Month(eD) - 2, 0)
sD = CDate(sD)
eD = CDate(eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And (cellD2 > eD Or cellD2 = Null) Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":C" & eR).Copy
ThisWorkbook.Sheets(1).Activate
Range("J1").Select
ActiveSheet.Paste
wbSrc.Sheets("Incoming").Activate
'Dates of month - 6
sD = DateSerial(Year(sD), Month(sD) - 3, 1)
eD = DateSerial(Year(eD), Month(eD) - 2, 0)
sD = CDate(sD)
eD = CDate(eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And (cellD2 > eD Or cellD2 = Null) Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":C" & eR).Copy
ThisWorkbook.Sheets(1).Activate
Range("G1").Select
ActiveSheet.Paste
wbSrc.Sheets("Incoming").Activate
'Dates of month - 9
sD = DateSerial(Year(sD), Month(sD) - 3, 1)
eD = DateSerial(Year(eD), Month(eD) - 2, 0)
sD = CDate(sD)
eD = CDate(eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And (cellD2 > eD Or cellD2 = Null) Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":C" & eR).Copy
ThisWorkbook.Sheets(1).Activate
Range("D1").Select
ActiveSheet.Paste
wbSrc.Sheets("Incoming").Activate
'Dates of month - 12
sD = DateSerial(Year(sD), Month(sD) - 3, 1)
eD = DateSerial(Year(eD), Month(eD) - 2, 0)
sD = CDate(sD)
eD = CDate(eD)
For count = i To 2 Step -1
cellD1 = CDate(Range("A" & count).Value)
cellD2 = CDate(Range("A" & (count + 1)).Value)
cellD3 = CDate(Range("A" & (count - 1)).Value)

If cellD1 <= eD And (cellD2 > eD Or cellD2 = Null) Then
eR = count
ElseIf cellD3 < sD And cellD1 >= sD Then
sR = count
End If
Next count
Range("A" & sR & ":C" & eR).Copy
ThisWorkbook.Sheets(1).Activate
Range("A1").Select
ActiveSheet.Paste
End Sub

CatDaddy
02-09-2012, 12:53 PM
and my workbook

CatDaddy
02-09-2012, 03:09 PM
After a little debugging:

The values for start date (sD) and end date (eD) in the first check are 2/1/2012 and 2/29/2012 which is correct

The first cell checked ("A" & i) is cell A449 which is correct

The values for start row (sR) and end row (eR) are 429 (which is what i expected) and 439 (which omits the last 10 dates in column A even though their values are less than the end date specified)

no idea what is causing this strange behaviour...:banghead:

CatDaddy
02-14-2012, 08:45 AM
no ideas? i'm really in a pinch here