[AccessD] Age calculation

Gustav Brock Gustav at cactus.dk
Tue Jun 26 10:11:24 CDT 2007


Hi Steve and A.D.

There are many ways to get it right but, after all, what you end up with - including my previous function - are just more or less creative ways to simulate what DateAdd() already does. To prove this, note that if you skip my function's ability to calculate negative ages and omit the optional choice for the day of "today", the function can be reduced to only a few lines:

Public Function AgeSimple( _
  ByVal datDateOfBirth As Date) _
  As Integer

' Returns the difference in full years from datDateOfBirth to current date.
'
' Calculates correctly for:
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'
' 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.
' After an idea of Markus G. Fischer.
'
' 2007-06-26. Cactus Data ApS, CPH.

  Dim datToday  As Date
  Dim intAge    As Integer
  Dim intYears  As Integer
    
  datToday = Date
  ' Find difference in calendar years.
  intYears = DateDiff("yyyy", datDateOfBirth, datToday)
  If intYears > 0 Then
    ' Decrease by 1 if current date is earlier than birthday of current year
    ' using DateDiff to ignore a time portion of datDateOfBirth.
    intAge = intYears - Abs(DateDiff("d", datToday, DateAdd("yyyy", intYears, datDateOfBirth)) > 0)
  End If
  
  AgeSimple = intAge
  
End Function

/gustav

>>> miscellany at mvps.org 25-06-2007 22:38 >>>
Hi Gustav,

Thanks a lot. Yes, I noticed that myself, after I posted here, but 
decided not to contradict myself again <g>.  However, I have edited my 
article here:
http://accesstips.datamanagementsolutions.biz/correctage.htm 
... and would welcome your further comments.

Regards
Steve


Gustav Brock wrote:
> Hi Steve
> 
> Sorry, it still fails miserably for, say, these dates:
> 
> DOB = #2/29/1992#
> AtDay = #2/28/1997#
> 
> returning 4 and not 5.
> 
-- 





More information about the AccessD mailing list