[AccessD] Age calculation

Hi John

You could say it is limited, or to be more precise: 99.95% correct.
It will fail in approximately 1 out of 2000 calculations.

1 out of 366 is a leapling of a leap year.
0 out of 365 is a leapling of a common year
Thus, for a four year period, 1 out of 1461 is a leapling given an even distribution of births over a year (which it is not). 
Round it to 1 of 1500.
For a four year period you will have four birth days. Thus leaplings will have 4 of 6000 birthdays.
Of these, 3 out of 4 will be miscalculated which equals 3 of 6000 or 1 for every 2000, which equals an error rate of 0.05%.

That may, of course, be acceptable depending on the purpose. But why? In most other cases you put a lot of efforts in reaching 0% errors.

/gustav

>>> john at winhaven.net 25-06-2007 23:40 >>>
Hi Gustav,
So the FMS SourceBook code I've been using is wrong!
AgeCalc = Year(Now) - Year(datBirthDate) + (DateSerial(Year(Now),
Month(datBirthDate), Day(datBirthDate)) > Now)

Thanks, I'm replacing it with yours!

John B.
 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com 
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Gustav Brock
Sent: Saturday, June 23, 2007 12:56 PM
To: accessd at databaseadvisors.com 
Subject: [AccessD] Age calculation

Hi all

As I have posted several times, most of the functions published around the
web for this simple task is crap because they fail for calculations around
Feb. 28./29., thus they are not suited for business use.

Recently I noticed that DateAdd() correctly returns Feb. 28 when adding a
count of years to dates of Feb. 29. resulting in dates of common years.
Markus G. Fischer at Expert-Exchange came up with the idea of using this
feature for serious age calculation, and so I did.

I did a rewrite of my previous Years function as it could be simplified
considerably using DateAdd and with the option to return negative ages in
either of two ways.

For a given datDate1, if datDate2 is decreased step wise one year from
returning a positive count to returning a negative count, one or two
occurrences of count zero will be returned.
If booLinear is False, the sequence will be:
  3, 2, 1, 0,  0, -1, -2
If booLinear is True, the sequence will be:
  3, 2, 1, 0, -1, -2, -3

More explanation in the in-line comments.

Here it is:

Public 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.
'
' Will return 0 for any varDate of the first year before datDateOfBirth.
' See comments for Years().
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2007-06-23. Supplemented with AgeLinear for count of negative ages offset
by -1.

  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

Public Function AgeLinear( _
  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.
'
' Will return -1 for any varDate of the first year before datDateOfBirth.
' See comments for Years().
'
' 2007-06-23. Cactus Data ApS, CPH.

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

  AgeLinear = Years(datDateOfBirth, datDate, True)
  
End Function

Public Function Years( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  Optional ByVal booLinear As Boolean) _
  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)
'
' Optionally returns negative counts rounded down to provide a ' linear
sequence of year counts.
' For a given datDate1, if datDate2 is decreased step wise one year from '
returning a positive count to returning a negative count, one or two '
occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
'   3, 2, 1, 0,  0, -1, -2
' If booLinear is True, the sequence will be:
'   3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDate1 and datDate2 will return '
results of same absolute value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDate1 and datDate2 will return '
results where the negative count is offset by -1.
' This behaviour mimics that of Int().

' DateAdd() is used for check for month end of February as it correctly '
returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2000-12-16. Leap year correction modified to be symmetrical.
'             Calculation of intDaysDiff simplified.
'             Renamed from YearsDiff() to Years().
' 2000-12-18. Introduced cbytMonthDaysMax.
' 2007-06-22. Version 2. Complete rewrite.
'             Check for month end of February performed with DateAdd()
'             after idea of Markus G. Fischer.

  Dim intDiff   As Integer
  Dim intSign   As Integer
  Dim intYears  As Integer
  
  ' Find difference in calendar years.
  intYears = DateDiff("yyyy", datDate1, datDate2)
  ' For positive resp. negative intervals, check if the second date
  ' falls before, on, or after the crossing date for a full 12 months period
  ' while at the same time correcting for February 29. of leap years.
  If DateDiff("d", datDate1, datDate2) > 0 Then
    intSign = Sgn(DateDiff("d", DateAdd("yyyy", intYears, datDate1),
datDate2))
    intDiff = Abs(intSign < 0)
  Else
    intSign = Sgn(DateDiff("d", DateAdd("yyyy", -intYears, datDate2),
datDate1))
    If intSign <> 0 Then
      ' Offset negative count of years to continuous sequence if requested.
      intDiff = Abs(booLinear)
    End If
    intDiff = intDiff - Abs(intSign < 0)
  End If
  
  ' Return count of years as count of full 12 months periods.
  Years = intYears - intDiff
  
End Function

/gustav

--
AccessD mailing list
AccessD at databaseadvisors.com 
http://databaseadvisors.com/mailman/listinfo/accessd 
Website: http://www.databaseadvisors.com 

-- 
AccessD mailing list
AccessD at databaseadvisors.com 
http://databaseadvisors.com/mailman/listinfo/accessd 
Website: http://www.databaseadvisors.com