[AccessD] Age calculation function

Gustav,

  I've been out of the office over the weekend, but I will try this one.
Thanks.

Mark Whittinghill
Symphony Information Services
612-333-1311
mwhittinghill at symphonyinfo.com
----- Original Message ----- 
From: "Gustav Brock" <gustav at cactus.dk>
To: "Access Developers discussion and problem solving"
<accessd at databaseadvisors.com>
Sent: Saturday, August 02, 2003 4:24 AM
Subject: Re: [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
>
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com
>
>