[AccessD] Age calculation function

Well my little function, posted just the other day, does a simple
compensation for the situation where the end date has the same day and month
as the start date. As a result it gets it right *almost* every time <g>.

What was throwing it off was the rules for leap years on century years. So I
made a simple modification to it and this function now really does get it
right "every time" (disregarding the switch from the Julian to Gregorian
calendar back in the 16th century).

So if you want to do age calculations in the "modern era" this little
function does the trick. All you astronomers and historians will need to
stick with converting modern dates to their Juliann equivalent.

Public Function CalculateAge(datBirth As Date, Optional endDate As Date) As
Long

    Dim lngNumDays As Long
    Dim nLeapCompensation As Long
    Dim eDate As Date
    If CDbl(endDate) = 0# Then
        eDate = Date
    Else
        eDate = endDate
    End If
    
    If Year(eDate) Mod 400 <> 0 Then
        Select Case Year(eDate) Mod 100
        Case 1, 2, 3
            nLeapCompensation = 1
        End Select
    End If
    
    lngNumDays = DateDiff("d", datBirth, eDate)
    If Day(datBirth) = Day(eDate) And Month(datBirth) = Month(eDate) Then
        ' it's the actual birthday
        ' add 1 to compensate for .25 in the division and also do the leap
year compensation
        lngNumDays = lngNumDays + 1 + nLeapCompensation
    End If
    CalculateAge = Int(lngNumDays / 365.25)
End Function

This works with the dates ranging from 100 to 9999 (the full range of dates
that the Access Date data type can handle)

Lambert

> -----Original Message-----
> From:	Gustav Brock [SMTP:gustav at cactus.dk]
> Sent:	Friday, August 01, 2003 3:29 PM
> To:	Access Developers discussion and problem solving
> Subject:	Re: [AccessD] Age calculation function
> 
> Hi Bobby
> 
> > This function can be made even more generic by passing in the month,
> day,
> > year, and day fraction (or the day as a fraction 12/4/2003 6:00AM would
> be
> > 12, 4.25, 2003).  This way, the function can handle years BC.
> 
> > Just in case anyone cared.  :-)
> 
> Well, could be interesting ... who knows, but it still fails an
> example like this:
> 
> ? (Greg2jd("03/01/1992") - Greg2jd("03/01/1987")) / 365.25
>  4,99931553730322
> 
> like any other method relying on dividing by 365,25. This method is
> what we call a "shoemaker method" as it is a method working in "most
> cases" but not all.
> 
> This is not to pick on you - because it is still published many places
> - but for the records, so no list member should be tempted to use a
> quick and dirty suggestion for serious use.
> 
> /gustav
> 
> 
> > Public Function Greg2JD(ByVal strDate As String) As Double
> > Dim A    As Long
> > Dim B    As Long
> > Dim MM   As Long
> > Dim YY   As Long
> > Dim DD   As Single
> 
> >    MM = Month(strDate)
> >    YY = Year(strDate)
> >    DD = Day(strDate)
>    
> >    'note, you could pass the time of day in as a fraction of a day.
> >    'if you do so, simply add the fraction of the day to DD
> >    'As is, this code assumes 0 hour, i.e. if it is the 4th,
> >    'then it assumed to be the 4th at 12:00:00 AM
> >    'DD = DD + sDayFrac     'sDayFrac is the variable holding fraction of
> day
> 
> >    If MM < 3 Then
> >       YY = YY - 1
> >       MM = MM + 12
> >       End If
> 
> >    A = YY \ 100         'integer math
> >    B = 2 - A + A \ 4    'integer math
> 
> >    Greg2JD = Int(365.25 * (YY + 4716)) + Int(30.6001 * (MM + 1)) + DD +
> B -
> > 1524.5
>    
> > End Function
> 
> > To work out our example, I called it with:
> > Debug.Print (Greg2JD("02/18/2002") - Greg2JD("02/29/1988")) / 365.25
> 
> _______________________________________________
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com