Mark Whittinghill
mwhittinghill at symphonyinfo.com
Tue Aug 5 12:02:32 CDT 2003
Thanks, Gustav. This works just peachy. I tweaked it a bit to fit what I
needed, but the algorithm works just great.
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
>
>