[AccessD] Dividing days into years and months

Gustav Brock gustav at cactus.dk
Wed Jul 28 05:56:25 CDT 2004


Hi Paul

> I can divide in Access the days from a date() into years with a simple
> /365, but is there a way to have months and days ... so I have years, months
> and days, please? 

That depends.

For days, use DateDiff("d", datFrom, Date())

For banking months, these always have a day count of 30,
and /365 is not reliable when including leap years.

For calendar months and years it is slightly more complicated as "a
month" is not always the same thing.
We use these functions:

<code>

Public Function Months( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date) _
  As Integer

' Returns the difference in full months 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.
' 2000-12-20.

  Dim intDay1           As Integer
  Dim intDay2           As Integer
  Dim intMonths         As Integer
  Dim intDaysDiff       As Integer
  Dim intReversed       As Integer
  
  ' No special error handling.
  On Error Resume Next
  
  intMonths = DateDiff("m", datDate1, datDate2)
  If intMonths = 0 Then
    ' Both dates fall within the same month.
  Else
    intDay1 = Day(datDate1)
    intDay2 = Day(datDate2)
    If Month(datDate1) < Month(DateAdd("d", 1, datDate1)) Then
      ' Date datDate1 is ultimo.
      ' Decrease date datDate2 if day of datDate2 it is higher.
      If intDay2 > intDay1 Then
        datDate2 = DateAdd("d", intDay1 - intDay2, datDate2)
        intDay2 = Day(datDate2)
      End If
    End If
    If Month(datDate2) < Month(DateAdd("d", 1, datDate2)) Then
      ' Date datDate2 is ultimo.
      ' Decrease date datDate1 if day of datDate1 it is higher.
      If intDay1 > intDay2 Then
        datDate1 = DateAdd("d", intDay2 - intDay1, datDate1)
        intDay1 = Day(datDate1)
      End If
    End If
    ' Calculate day difference.
    intDaysDiff = intDay1 - intDay2
    intReversed = Sgn(intMonths)
    ' Decrease count of months by one if dates are closer than one month.
    intMonths = intMonths - (intReversed * Abs((intReversed * intDaysDiff) > 0))
  End If
  
  Months = intMonths
  
End Function


Public Function Years( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date) _
  As Integer

' Returns the difference in full years 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.
' 2000-11-03.
' 2000-12-16. Leap year correction modified to be symmetrical.
'             Calculation of intDaysDiff simplified.
'             Renamed from YearsDiff() to Years().
' 2000-12-18. Added cbytMonthDaysMax.

  ' Constants for leap year calculation. Last normal date of February.
  Const cbytFebMonth      As Byte = 2
  Const cbytFebLastDay    As Byte = 28
  ' Maximum number of days in a month.
  Const cbytMonthDaysMax  As Byte = 31
  
  Dim intYears            As Integer
  Dim intDaysDiff         As Integer
  Dim intReversed         As Integer
  
  ' No special error handling.
  On Error Resume Next

  intYears = DateDiff("yyyy", datDate1, datDate2)
  If intYears = 0 Then
    ' Both dates fall within the same year.
  Else
    ' Check for ultimo February and leap years.
    If (Month(datDate1) = cbytFebMonth) And (Month(datDate2) = cbytFebMonth) Then
      ' Both dates fall in February.
      ' Check if dates are at ultimo February.
      If (Day(datDate1) >= cbytFebLastDay) And (Day(datDate2) >= cbytFebLastDay) Then
        ' Both dates are at ultimo February.
        ' Check if the dates fall in leap years.
        If Day(DateSerial(Year(datDate1), cbytFebMonth + 1, 0)) = cbytFebLastDay Xor _
          Day(DateSerial(Year(datDate2), cbytFebMonth + 1, 0)) = cbytFebLastDay Then
          ' Only one date falls within a leap year.
          ' Adjust both dates to day 28 of February.
          datDate1 = DateAdd("d", cbytFebLastDay - Day(datDate1), datDate1)
          datDate2 = DateAdd("d", cbytFebLastDay - Day(datDate2), datDate2)
        Else
          ' Both dates fall either in leap years or non leap years.
          ' No adjustment needed.
        End If
      End If
    End If
    ' Calculate day difference using months and days as Days() will fail when
    ' comparing leap years with non leap years for dates after February.
    intDaysDiff = (Month(datDate1) * cbytMonthDaysMax + Day(datDate1)) - (Month(datDate2) * cbytMonthDaysMax + Day(datDate2))
    intReversed = Sgn(intYears)
    ' Decrease count of years by one if dates are closer than one year.
    intYears = intYears + (intReversed * ((intReversed * intDaysDiff) > 0))
  End If
  
  Years = intYears
  
End Function

</code>

/gustav




More information about the AccessD mailing list