PDA

View Full Version : Excel 2007 macro for comparing multiple dates



samiam2010
07-23-2010, 12:17 PM
Hello again! I am needing some more assistance with a macro that compares two or more date variables; personally, I feel like I'm making it way more complicated than it needs to be. The report I will be using this for fills cells with Date and Time, i.e. 7/23/10 10:58:42 AM and I need to compare the DATE portion of these cells with my system date. I seem to be running into a few issues:

1) The timestamp in the cells is EST, whereas my system time is CST.

2) I am having trouble getting the code I've come up with to ignore the timestamp, as the only relevant info I need to come is month and day.

3) Whenever I need to compare more than one date column to my system date, I am running into issues where the code seems to be ignoring the third variable to check.

4) I can't seem to get an "=" Operand to work when comparing dates, and I am thinking this is because of the timestamps being different to my system time when running the marco.

Essentially, I need the macro to work like this:
s = system date
c = cutoff date
a = approved date
m = meeting date
If c > s +2 days Then x
If c = or < s +2 days And a = s Then y
If c = or < s +2 days And a < s And m = s Then z

Code I am attempting to use:


Sub FilteringABNSDates()

Dim ballotID As Integer
Dim iRow As Integer
Dim iballotIDColumn As Integer
Dim iCutoffDateColumn As Integer
Dim iMeetingDateColumn As Integer
Dim iApprovedDateColumn As Integer
Dim iCommentsColumn As Integer
Dim bNextRow As Boolean
' Always insert a new column to hold any comments.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Comments"

iCutoffDateColumn = Cells.Find(What:="CUTOFF_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iballotIDColumn = Cells.Find(What:="BALLOT_ID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iCommentsColumn = Cells.Find(What:="Comments", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iMeetingDateColumn = Cells.Find(What:="MEETING_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iApprovedDateColumn = Cells.Find(What:="BALLOT_APPROVED_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
' Loop through all the rows and make appropriate checks.
' Keep looping until the Ballot ID column comes back blank.
iRow = 1
Do While Cells(iRow, iballotIDColumn).Value <> ""
bNextRow = False
iRow = iRow + 1
' Check for Cutoff Date Later
If (CDate(Cells(iRow, iCutoffDateColumn).Value) > CDate(DateAdd("d", 2, Date))) Then
Cells(iRow, 1).Value = "cutoff later"
bNextRow = True
End If
' Check for Same-day Approved
If Not bNextRow And (CDate(Cells(iRow, iCutoffDateColumn).Value) < CDate(DateAdd("d", 2, Date))) And (CDate(Cells(iRow, iApprovedDateColumn).Value) > CDate(DatePart("m", Now) & "-" & DatePart("d", Now) & "-" & DatePart("yyyy", Now))) Then
Cells(iRow, 1).Value = "approved today"
bNextRow = True
End If
' Check for Same-day Meeting
If Not bNextRow And (CDate(Cells(iRow, iCutoffDateColumn).Value) < CDate(DateAdd("d", 2, Date))) And (CDate(Cells(iRow, iApprovedDateColumn).Value) < CDate(DatePart("m", Now) & "-" & DatePart("d", Now) & "-" & DatePart("yyyy", Now))) And (CDate(Cells(iRow, iMeetingDateColumn).Value) < CDate(DatePart("m", Now) & "-" & DatePart("d", Now) & "-" & DatePart("yyyy", Now))) Then
Cells(iRow, 1).Value = "meeting today"
bNextRow = True
End If
Loop
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit

End Sub

mdmackillop
07-24-2010, 01:04 AM
As you are comparing dates only, convert these to long and use the simpler variables in your code. If you can't then find the proiblem, let us know.
e.g.

Dim coDate As Long
coDate = CLng(Cells(iRow, iCutoffDateColumn))
If coDate > Date + 2 Then
Cells(iRow, 1).Value = "cutoff later"
bNextRow = True
End If

samiam2010
07-26-2010, 08:14 AM
Thanks again md! I have a follow-up question, what if I need to compare system date, a date in the data, and then one or more additional columns that have text data? Will the same declaration statements work with regards to dropping the time component of the date data?

samiam2010
07-28-2010, 12:20 PM
I've been running into a new problem with this particular code. What I have noticed is that it seems to be factoring in the time based upon my system date and time. For example, I want my argument to go something like this:

If data > system date + 2 Then x

If the data is 7/30/10 11:00 AM and my current system time is, for example, 7/28/2010 1:00 PM, the macro is considering the data to be less than my system date and time plus two days, which is technically is since the 48-hour mark would be 7/30/10 1:01 PM and beyond. However, I need the code to ignore both my system time AND any time information contained in the cell; I ONLY want it to consider the day portion of the two data points. Below is an example of the problem I'm running into(apologies for the awkward formatting):

Comments_______Notes_______CUTOFF_DATE
**macro error**_cutoff later__7/30/10 11:00 AM
cutoff later______cutoff later_ 7/30/10 11:59 PM


Comments______Notes_______CUTOFF_DATE__BALLOT_APPROVED_DATE
approved today_approved today__7/23/10 11:00 AM___7/28/10 10:33 AM
**macro error**_approved today_7/29/10 5:00 PM____7/28/10 10:30 AM


The "Notes" column is the note I entered when filtering through the report manually, and the "Comments" column is the value I want the macro to enter. The code is as follows:


Sub FilteringABNS()

Dim iRow As Integer
Dim iballotIDColumn As Integer
Dim iCommentsColumn As Integer
Dim bNextRow As Boolean
' Always insert a new column to hold any comments.
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = "Comments"
iCutoffDateColumn = Cells.Find(What:="CUTOFF_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iballotIDColumn = Cells.Find(What:="BALLOT_ID", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iCommentsColumn = Cells.Find(What:="Comments", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iMeetingDateColumn = Cells.Find(What:="MEETING_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
iApprovedDateColumn = Cells.Find(What:="BALLOT_APPROVED_DATE", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Column
' Loop through all the rows and make appropriate checks.
' Keep looping until the Ballot ID column comes back blank.
iRow = 1
Do While Cells(iRow, iballotIDColumn).Value <> ""
bNextRow = False
iRow = iRow + 1
Dim ApprovedDate As Long
ApprovedDate = CLng(Cells(iRow, iApprovedDateColumn))
Dim MeetingDate As Long
MeetingDate = CLng(Cells(iRow, iMeetingDateColumn))
Dim CutoffDate As Long
CutoffDate = CLng(Cells(iRow, iCutoffDateColumn))

' Check for Cutoff Later
If CutoffDate > Date + 2 Then
Cells(iRow, 1).Value = "cutoff later"
bNextRow = True

' Check for Same-day Approved
ElseIf Not bNextRow And CutoffDate < Date + 2 And ApprovedDate = Date Then
Cells(iRow, 1).Value = "approved today"
bNextRow = True

' Check for Same-day Meeting
ElseIf Not bNextRow And CutoffDate < Date + 2 And MeetingDate = Date Then
Cells(iRow, 1).Value = "meeting today"
bNextRow = True
End If
Loop
' Autosize the column after filling it all in.
Columns("A:A").Select
Columns("A:A").EntireColumn.AutoFit
End Sub