[AccessD] The Mother of all Age calculation functions - Here it is!!!

Dear Lambert et al,
If I want a full decimal age, I find that does not give the right answer for someone born on 2-8-2000, (Today) but it gave me a
great starting point....
After 4 hours....this does, (At least it does to 3 decimal places)

Public Function CalculateAge(datBirth As Date, Optional endDate As Date) As Single
'Function written by David Hingston, 2-8-2003, significantly evolved from that of Lambert Heenan, AccessD E-Mail List
'Replication in databases welcome providing references maintained
    Dim lngNumDays, SNumDays As Single
    Dim nLeapCompDOB, nLeapCompNow As Single
    Dim eDate As Date
    Dim T, T1 As Integer

    If CDbl(endDate) = 0# Then
        eDate = Date
    Else
        eDate = endDate
    End If

    T = Year(datBirth) Mod 4
     If Year(datBirth) Mod 4 <> 0 Then
        Select Case T
        Case 1
            nLeapCompDOB = 0.25
        Case 2
            nLeapCompDOB = 0.5
        Case 3
            nLeapCompDOB = 0.75
        End Select
    End If

    T1 = Year(eDate) Mod 4
    If T1 <> 0 Then
        Select Case T1
        Case 1
            nLeapCompNow = 0.25
        Case 2
            nLeapCompNow = 0.5
        Case 3
            nLeapCompNow = 0.75
        End Select
    End If

    lngNumDays = DateDiff("d", datBirth, eDate)
    SNumDays = lngNumDays + nLeapCompNow - nLeapCompDOB
'365.25 gives a 1 day error in every 128 years!  Doesn't seem to matter in the last 100 years
    CalculateAge = SNumDays / 365.25
End Function

Of course it is not tested or designed to take into account birth TIME...and TIME of Age estimation......(grin)
I hope it goes a little way to pay back advice I have received here.  (grin)  (Yes I know I have some way to go yet......)

Kind regards,
A "Way Proud" David Hingston
_________________________________________________________________________
Engines2Go - Now THAT's a Search Engine!
Automated major search engine manager
Makes searching quicker and easier - Have you tried it?
http://www.engines2go.com/
http://www.cheqsoft.com/  The home of Clipboard Express, MP3 Detective, TimesOwn and Break Reminder.

----- Original Message -----
From: "Heenan, Lambert" <Lambert.Heenan at AIG.com>
To: "'Access Developers discussion and problem solving'" <accessd at databaseadvisors.com>
Cc: <gustav at cactus.dk>
Sent: Saturday, August 02, 2003 8:38 AM
Subject: RE: [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