Consulting

Results 1 to 4 of 4

Thread: Excel 2007 macro for comparing multiple dates

  1. #1

    Excel 2007 macro for comparing multiple dates

    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:

    [vba]
    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[/vba]

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    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.
    [vba]
    Dim coDate As Long
    coDate = CLng(Cells(iRow, iCutoffDateColumn))
    If coDate > Date + 2 Then
    Cells(iRow, 1).Value = "cutoff later"
    bNextRow = True
    End If
    [/vba]
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    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?

  4. #4
    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:

    [vba]
    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
    [/vba]

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •