[AccessD] Age calculation function

Hi Mark

> Is there a solution to this?

Certainly. It can be found here at Drew's archive:

  http://www.wolfwares.com/AccessD/postinfo.asp?Post=29448

However, Drew, the indenting is bad, so below is again the function we
use. 

I'm not claiming this method to be the mother of anything but it works
without errors. To quote myself from 2002-10-04:

<quote>

We have have had the need to calculate the correct age no matter what,
and I have yet to see this function fail. It has been posted before but
with so many "Age_is_just_about()" functions it seems to be the time to
post it again.

The crucial point is the correct age count for those poor souls born on
the 29th of February:


Function Age(ByVal datDateOfBirth As Date, Optional ByVal varDate As Variant) As Integer

' Calculates age at today's date or at a specified date earlier or later in time.
' Uses Years() for calculating difference in years.
'
' Gustav Brock, Cactus Data ApS.
' 2000-11-03.

  Dim datDate As Date
  
  ' No special error handling.
  On Error Resume Next
  
  If IsDate(varDate) Then
    datDate = CDate(varDate)
  Else
    datDate = Date
  End If

  Age = Years(datDateOfBirth, datDate)
  
End Function

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

</quote>

/gustav