[AccessD] Date Difference As Completed Years-Months-Days

Gustav,

    Your idea of using the built in DateAdd() function is absolutely great. It ensures consistent results without needing conditional checks for various date combinations, including month ends and leap years. Thanks for coming up with this outstanding solution.

    Amongst the host of similar functions that have been attempted from time to time, yours appears to be the optimum one. 

    Another variation of YMD function, using your approach, is placed below. Results over sample tests at my end appear to be ok.

    Kevin - You could try out Gustav's function and might consider adopting it in preference to that by Chip Pearson.

Best wishes,
A.D. Tejpal
------------

' Sample function for date difference as YMD
' (It uses DateAdd approach evolved by Gustav, 
' as demonstrated in his function YearsMonthsDays())
'===================================
Public Function Fn_GetDateDiffAsYMD( _
            DtFrom As Date, _
            Optional DtUpto As Variant) As String
    ' Returns date difference as a string of
    ' Years, Months, Days
    
    ' If second argument is not supplied, it defaults
    ' to today's date - the function then serves as
    ' age calculator, with first argument being
    ' date of birth.
    
    ' If DtFrom is greater than DtUpto, the result
    ' gets prefixed with "(minus) "
    Dim Dt1 As Date, Dt2 As Date, Dt As Date
    Dim Yr As Long, Mn As Long, Dy As Long
    Dim Prefix As String
    
    If IsMissing(DtUpto) Then
        Dt = Date
    Else
        Dt = IIf(IsDate(DtUpto), DtUpto, Date)
    End If
    
    If Dt = DtFrom Then
        Fn_GetDateDiffAsYMD = "NIL"
        Exit Function
    End If
    
    ' Set Dt2 as the greater one
    If Dt > DtFrom Then
        Dt2 = Dt
        Dt1 = DtFrom
        Prefix = ""
    Else
        Dt2 = DtFrom
        Dt1 = Dt
        Prefix = "(Minus) "
    End If
    
    ' Get number of completed months
    ' Subtract 1 if Dt2 is not the last day of
    ' month and Day(Dt2) < Day(Dt1)
    Mn = DateDiff("m", Dt1, Dt2) - _
            IIf(Day(Dt2 + 1) > 1 And _
            Day(Dt2) < Day(Dt1), 1, 0)
    
    ' Get the difference of days between Dt2
    ' and projected date in last completed month
    ' (obtained by adding Mn months to Dt1)
    Dt = DateAdd("m", Mn, Dt1)
    Dy = DateDiff("d", Dt, Dt2)
    
    Yr = Mn \ 12
    Mn = Mn Mod 12
    
    Fn_GetDateDiffAsYMD = Prefix & _
                IIf(Yr > 0, Yr & _
                IIf(Yr > 1, " Years", " Year"), "") & _
                IIf(Yr > 0 And Mn > 0, ", ", "") & _
                IIf(Mn > 0, Mn & _
                IIf(Mn > 1, " Months", " Month"), "") & _
                IIf((Yr > 0 Or Mn > 0) And Dy > 0, _
                ", ", "") & IIf(Dy > 0, Dy & _
                IIf(Dy > 1, " Days", " Day"), "")
End Function
'==================================

  ----- Original Message ----- 
  From: Gustav Brock 
  To: accessd at databaseadvisors.com 
  Sent: Tuesday, March 30, 2010 23:10
  Subject: Re: [AccessD] Date Difference As Completed Years-Months-Days


  Hi A.D.

  I can see I missed your point in my first posting ...

  However, to handle the 30/31 days problem (not to say the 28/29 days of February) when counting months and days, I have redesigned my old Months function to work the same way as the Years function:

  <code>
  Public Function Months( _
    ByVal datDate1 As Date, _
    ByVal datDate2 As Date, _
    Optional ByVal booLinear As Boolean) _
    As Integer

  ' Returns the difference in full months between datDate1 and datDate2.

  ' <<Snipped>>
    
  End Function
  </code>

  Further, by counting the total months this can easily be converted to full years and remaining months
  Now, all that is left is to find the count of remaining days. This is not easy as it will be zero for many date combinations where both dates are at ultimo of a month, for example for both of these intervals:

    From 2015-03-30 to 2016-04-30
    From 2015-03-31 to 2016-04-30

  But I've created a function that does this:

  <code>
  Public Function YearsMonthsDays( _
    ByVal datDate1 As Date, _
    ByVal datDate2 As Date, _
    Optional ByRef lngYears As Long, _
    Optional ByRef lngMonths As Long, _
    Optional ByRef lngDays As Long) _
    As String
    
  ' Returns the difference in years, months, and days between datDate1 and datDate2.
  '
  ' Calculates correctly for:
  '   negative differences
  '   leap years
  '   dates of 29. February
  '   date/time values with embedded time values
  '   negative date/time values (prior to 1899-12-29)
  '
  ' Gustav Brock, Cactus Data ApS.
  ' 2010-03-30.

    ' Count of months in a calendar year.
    Const cintMonths  As Integer = 12
    
    Dim datDateMonth  As Date
    Dim intDays       As Integer
    
    ' No special error handling.
    On Error Resume Next
    
    lngMonths = Months(datDate1, datDate2)
    
    datDateMonth = DateAdd("m", lngMonths, datDate1)
    lngDays = DateDiff("d", datDateMonth, datDate2)
    intDays = Sgn(lngDays)
    If intDays <> 0 Then
      If intDays <> Sgn(DateDiff("d", datDate1, datDate2)) Then
        lngDays = 0
      End If
    End If
    
    lngYears = lngMonths \ cintMonths
    lngMonths = lngMonths Mod cintMonths
    
    YearsMonthsDays = CStr(lngYears) & " year(s), " & CStr(lngMonths) & " month(s), " & CStr(lngDays) & " day(s)"

  End Function
  </code>

  It will even count correctly for negative periods - where date1 is later than date2.
  To allow for general use, it also returns ByRef the count of years, months, and days while the normal return value is a formatted string like:

    12 year(s), 7 month(s), 3 day(s)

  I think this should fulfil your requirements.

  /gustav