Calculating "X Years, X Months and X Days" between two dates (1 Viewer)

willknapp

Registered User.
Local time
Today, 02:58
Joined
Aug 16, 2012
Messages
93
Find the difference between two dates is simple if you're simply looking for the number of days between them. However, if you're looking to express the difference in a bit more user-friendly way, you can use the following code to calculate the difference in years, months, and days. The code accounts for zero values, plurals and the Oxford comma. Further, it automatically sets the later of the two dates to the End date, so the dates can be used interchangeably.

Examples:
June 4, 2010, July 3, 2012 returns "2 Years and 29 Days"
June 4, 2010, July 5, 2011 returns "1 Year, 1 Month and 1 Day"
June 4, 2010, June 5, 2010 returns "1 Day"

Code:
Function DiffOfTwoDates(dtmDate1 As Date, dtmDate2 As Date) As String
    ' Written by Will Knapp, Freelance Access Developer, 2013
    
    Dim dtmStart As Date, dtmEnd As Date
    Dim strDiff As String   ' Resulting String
    Dim yDiff As Integer    ' Year Difference
    Dim mDiff As Integer    ' Month Difference
    Dim dDiff As Integer    ' Day Difference
    Dim CommaLoc As Integer
    
    ' Assign the start and end dates accordingly
    If dtmDate1 > dtmDate2 Then
        dtmStart = dtmDate2
        dtmEnd = dtmDate1
    Else
        dtmStart = dtmDate1
        dtmEnd = dtmDate2
    End If
    
    If dtmStart = dtmEnd Then
        strDiff = "0 Days"
    
    ' If the day number of the end date is equal to or larger than the day number of start month
    ElseIf DatePart("d", dtmEnd) >= DatePart("d", dtmStart) Then
      
        ' find the month difference
        mDiff = DateDiff("m", dtmStart, dtmEnd)
        
        ' Find the Day difference
        dDiff = DatePart("d", dtmEnd) - DatePart("d", dtmStart)
                    
    ' If the day number of the end date is less than the day number of the start month
    Else
    
        ' Calculate the difference between the months and subtract one.
        mDiff = DateDiff("m", dtmStart, dtmEnd) - 1

        ' Subtract the day number of the start month from the total days in that month
        dDiff = DatePart("d", DateSerial(year(dtmStart), Month(dtmStart) + 1, 0)) - DatePart("d", dtmStart)
        
        ' Add the number of days in the end month
        dDiff = dDiff + DatePart("d", dtmEnd)
        
    End If
    
    ' Determine the number of years based on the number of months
    yDiff = Int(mDiff / 12)
    
    ' Determine the number of extra months in addition to the years
    mDiff = mDiff Mod 12
    
    ' Construct the string, accounting for plurals, ignoring and "zero" values
    If dDiff > 0 Then strDiff = dDiff & IIf(dDiff = 1, " Day", " Days")
    If mDiff > 0 Then strDiff = mDiff & IIf(mDiff = 1, " Month", " Months") & ", " & strDiff
    If yDiff > 0 Then strDiff = yDiff & IIf(yDiff = 1, " Year", " Years") & ", " & strDiff
    
    ' Remove trailing space and comma that will be there if dDiff = 0
    strDiff = Trim(strDiff)
    If Right(strDiff, 1) = "," Then strDiff = Left(strDiff, Len(strDiff) - 1)
    
    ' Replace the Oxford comma with "and", if necessary
    CommaLoc = InStrRev(strDiff, ",")
    If CommaLoc > 0 Then strDiff = Left(strDiff, CommaLoc - 1) & " and" & Right(strDiff, Len(strDiff) - CommaLoc)
    DiffOfTwoDates = strDiff

End Function
 
Last edited:

MarkK

bit cruncher
Local time
Yesterday, 23:58
Joined
Mar 17, 2004
Messages
8,183
This seems to fail when I use dates #2/2/10# and #1/1/13#. The result is . . .
Code:
2 Years, 10 Months and 27 Days

. . . but if I add these back together in the immediate pane . . .
Code:
? DateAdd("yyyy", 2, #2/2/10#)
2/02/12 
? DateAdd("m", 10, #2/2/12#)
12/02/12 
? DateAdd("d", 27, #12/2/12#)
[COLOR="Red"]12/29/12 [/COLOR]
. . . I don't get back to #1/1/13#
 

MarkK

bit cruncher
Local time
Yesterday, 23:58
Joined
Mar 17, 2004
Messages
8,183
Here's my stab at it . . .
Code:
[SIZE="2"]Private Sub Test167419023674()
    Debug.Print Join(MyDateDiff(#2/2/2010#, #1/1/2013#))
End Sub

Private Function MyDateDiff(d1 As Date, d2 As Date) As Variant
[COLOR="Green"]'   returns the difference between two dates in an array where
'   array element (0) = year, (1) = month and (2) = day[/COLOR]
    Dim dy As Long
    Dim dm As Long
    Dim dd As Long
    Dim tmp As Date
    
    If d1 > d2 Then     [COLOR="Green"]'if first date is greater[/COLOR]
        tmp = d1       [COLOR="Green"] 'the swap them[/COLOR]
        d1 = d2
        d2 = tmp
    End If
    
    dy = DateDiff("yyyy", d1, d2)  [COLOR="Green"] 'calc years[/COLOR]
    tmp = DateAdd("yyyy", dy, d1)   [COLOR="Green"]'get remainder[/COLOR]
    dm = DateDiff("m", tmp, d2)    [COLOR="Green"] 'calc months[/COLOR]
    tmp = DateAdd("m", dm, tmp)    [COLOR="Green"] 'get remainder[/COLOR]
    dd = DateDiff("d", tmp, d2)   [COLOR="Green"]  'calc days[/COLOR]
    
    If dm < 0 Then                 [COLOR="Green"] 'if month value is negative[/COLOR]
        dy = dy - 1                [COLOR="Green"] 'calc one less year[/COLOR]
        dm = 12 + dm               [COLOR="Green"] 'and get remaining months[/COLOR]
    End If
    
    If dd < 0 Then                 [COLOR="Green"] 'if day value is negative[/COLOR]
        dm = dm - 1                 [COLOR="Green"]'calc one less month[/COLOR]
        dd = DaysLastMonth(d2) + dd [COLOR="Green"]'and get remaining days[/COLOR]
    End If
    
    MyDateDiff = Array(dy, dm, dd)
    
End Function

Private Function DaysLastMonth(d1 As Date) As Integer
[COLOR="Green"]'   returns the number of days in the month prior to d1[/COLOR]
    Dim FirstOfThisMonth As Date
    
    FirstOfThisMonth = DateSerial(Year(d1), Month(d1), 1)[COLOR="Green"] 'find the first[/COLOR]
    DaysLastMonth = Day(FirstOfThisMonth - 1)             [COLOR="Green"]'find the day before[/COLOR]
End Function[/SIZE]
 

willknapp

Registered User.
Local time
Today, 02:58
Joined
Aug 16, 2012
Messages
93
This seems to fail when I use dates #2/2/10# and #1/1/13#. The result is . . .
Code:
2 Years, 10 Months and 27 Days

. . . but if I add these back together in the immediate pane . . .
Code:
? DateAdd("yyyy", 2, #2/2/10#)
2/02/12 
? DateAdd("m", 10, #2/2/12#)
12/02/12 
? DateAdd("d", 27, #12/2/12#)
[COLOR="Red"]12/29/12 [/COLOR]
. . . I don't get back to #1/1/13#

If you add the days, then the months, and then the years (rather than the other way around) it does work:

Code:
? DateAdd("d", 27, #2/2/10#)
3/1/10
? DateAdd("m", 10, #3/1/10#)
1/1/11
? DateAdd("y", 2, #1/1/11#)
1/1/13

It's not the most reliable method for determining the difference, given that months have anywhere from 28 to 31 days, and I wouldn't use this for any critical calculations. It was developed for someone who wanted to display the date in a conversational way.
 

Users who are viewing this thread

Top Bottom