[AccessD] Age calculation function

Gustav,

    Threads related to age calculation appear to remain ever popular.

    Any reason for limiting the return value to an integer ? Would it not be preferable to have it as single (Integer portion to represent comnpleted years and decimal portion based upon number of days lapsed in final unfinished year if any) ? The result could be used at the level of precision actually needed.

Regards,
A.D.Tejpal
--------------

----- 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

-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://databaseadvisors.com/pipermail/accessd/attachments/20030806/41881884/attachment-0001.html>