Calculating age from d/o/b to d/o/d or the present date 3

[MADDPM]

I have created a calculated field in a query (modified from a FAQ: faq181-55) which works great, calculating from the present date as well as a date of death - but it's not in the format I desire; e.g. 9 months = 0.666666666666667 or .67.

CalcAge: IIf(IsNull([DOD]),Fix(DateDiff("m",[DOB],Now())+Int(Format(Now(),"mmdd")<Format([DoB],"mmdd")))/12,Fix(DateDiff("m",[DOB],[DOD])+Int(Format([DOD],"mmdd")<Format([DOB],"mmdd")))/12)

So I tried the following function as a starting point to get closer to the format I'm looking for (years, months) (ref:

http://support.microsoft.com/kb/210522):

Option Compare Database

Option Explicit

'*************************************************************
' FUNCTION NAME: Age()
'
' PURPOSE:
' Calculates age in years from a specified date to today's date.
'
' INPUT PARAMETERS:
' StartDate: The beginning date (for example, a birth date).
'
' RETURN
' Age in years.
'
'*************************************************************
Function Age(varBirthDate As Variant) As Integer
Dim varAge As Variant

If IsNull(varBirthDate) Then Age = 0: Exit Function

varAge = DateDiff("yyyy", varBirthDate, Now)
If Date < DateSerial(Year(Now), Month(varBirthDate), _
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function

'*************************************************************
' FUNCTION NAME: AgeMonths()
'
' PURPOSE:
' Compliments the Age() function by calculating the number of months
' that have expired since the last month supplied by the specified date.
' If the specified date is a birthday, the function returns the number of
' months since the last birthday.
'
' INPUT PARAMETERS:
' StartDate: The beginning date (for example, a birthday).
'
' RETURN
' Months since the last birthday.
'*************************************************************
Function AgeMonths(ByVal StartDate As Variant) As Integer

Dim tAge As Double
tAge = (DateDiff("m", StartDate, Now))
If (DatePart("d", StartDate) > DatePart("d", Now)) Then
tAge = tAge - 1
End If
If tAge < 0 Then
tAge = tAge + 1
End If

AgeMonths = CInt(tAge Mod 12)

End Function

But when I invoke the function, using =Age([DOB]) & " yrs " & AgeMonths([DOB]) & " mos" as the control source of an unbound text box in a form, the control displays #Error - although the control source is accepted without error when I close the properties box. I've checked for circular references, repeat of field names, field size, but nothing seems to solve the problem.

Can someone please tell me what I'm doing wrong?

Thanks in advance.
Using Access 2003, (11.8166.8221) SP3

 

[MichaelRed]

Public Function basDOB2AgeExt(DOB As Date, Optional AsOf As Date = -1) As String


    'Michael Red    5/23/02
    'Dob is just the date of Birth
    'AsOf is an optional date to check - as in examples 1 & 2
    'Otherwise, the DOB is checked against the Current Date

    '? basDOB2AgeExt(#8/21/42#)
    '59 Years 9 Months and 2 Days.

    '? basDOB2AgeExt(#8/21/1942#, #8/20/2022#)
    '79 Years 11 Months and 30 Days.

    '? basDOB2AgeExt(#8/21/1942#, #8/21/2022#)
    '80 Years 0 Months and 0 Days.

    Dim tmpAge As Integer       'Simple DateDiff w/o Birthday correction
    Dim tmpDt As Date           'Date to use in intermediate Calcs
    Dim DtCorr As Boolean       'BirthDay Before or After date in question
    Dim YrsAge As Integer
    Dim MnthsAge As Integer     'Additional Mnths
    Dim DaysAge As Integer      'Additional Days

    If (AsOf = -1) Then         'Check for (Optional Date to Check against)
        AsOf = Date             'If Not Supplied, Assume Today
    End If

    tmpAge = DateDiff("YYYY", DOB, AsOf)        'Just the Years considering Jan 1, Mam
    DtCorr = DateSerial(Year(AsOf), Month(DOB), Day(DOB)) > AsOf

    YrsAge = tmpAge + DtCorr           'Just Years and Correction
    tmpDt = DateAdd("yyyy", YrsAge, DOB)

    MnthsAge = DateDiff("m", tmpDt, AsOf)
    DtCorr = DateAdd("m", MnthsAge, tmpDt) > AsOf
    MnthsAge = MnthsAge + DtCorr

    tmpDt = DateAdd("m", MnthsAge, tmpDt)
    DaysAge = DateDiff("d", tmpDt, AsOf)

    basDOB2AgeExt = YrsAge & " Years " & MnthsAge & " Months and " & DaysAge & " Days."

End Function
[code]


MichaelRed

 

[MADDPM]

Good morning Michael,

Thank you so much for the code. I'm still doing something wrong . . .

If I put the code in a new module, create a control on the form with the property: "=basDOB2AgeExt()", I receive the following error from the control: "The expression you entered has a function containing the wrong number of arguments." and then the control displays #Name?. Immediate window test results in "Compile Error: Argument not optional"

If I put the code in the Class Object Form level for the correlated form, create a control on the form with the property: "=basDOB2AgeExt()", the control simply displays #Name?. Immediate window test results in "Compile Error: Sub of function not defined."

Here's my customized code:
Public Function basDOB2AgeExt(DOB As Date, Optional DOD As Date = -1) As String

'Michael Red 5/23/02
'DOB is just the date of Birth
'DOD is an optional date to check - as in examples 1 & 2
'Otherwise, the DOB is checked against the Current Date

'? basDOB2AgeExt(#8/21/42#)
'59 Years 9 Months and 2 Days.

'? basDOB2AgeExt(#8/21/1942#, #8/20/2022#)
'79 Years 11 Months and 30 Days.

'? basDOB2AgeExt(#8/21/1942#, #8/21/2022#)
'80 Years 0 Months and 0 Days.

Dim tmpAge As Integer 'Simple DateDiff w/o Birthday correction
Dim tmpDt As Date 'Date to use in intermediate Calcs
Dim DtCorr As Boolean 'BirthDay Before or After date in question
Dim YrsAge As Integer
Dim MnthsAge As Integer 'Additional Mnths
Dim DaysAge As Integer 'Additional Days

If (DOD = -1) Then 'Check for (Optional Date to Check against)
DOD = Date 'If Not Supplied, Assume Today
End If

tmpAge = DateDiff("YYYY", DOB, DOD) 'Just the Years considering Jan 1, Mam
DtCorr = DateSerial(Year(DOD), Month(DOB), Day(DOB)) > DOD

YrsAge = tmpAge + DtCorr 'Just Years and Correction
tmpDt = DateAdd("yyyy", YrsAge, DOB)

MnthsAge = DateDiff("m", tmpDt, DOD)
DtCorr = DateAdd("m", MnthsAge, tmpDt) > DOD
MnthsAge = MnthsAge + DtCorr

tmpDt = DateAdd("m", MnthsAge, tmpDt)
DaysAge = DateDiff("d", tmpDt, DOD)

basDOB2AgeExt = YrsAge & " Years " & MnthsAge & " Months and " & DaysAge & " Days."

End Function

Please help - what am I doing wrong?

Thanks!

 

[RobertT687]

You aren't passing in the non-optional date_of_birth value.

You control should have a value of

=basDOB2AgeExt([MyDOBColumn])

where [MyDOBColumn] is a table column containing a date_of_birth.

 

[MADDPM]

Hello Robert,

Thank you so much for the input - but even when I set the control property to "=basDOB2AgeExt([DOB])" I receive the display error of #name? ("DOB" being the name of the column containing dates of birth.)

Might you have any other suggestions?

Thanks in advance.

 

[MADDPM]

Oooops! It works. After placing the code back in it's own module, voila!

Thanks every so, so much!

 

[RobertT687]

Not sure why you are getting the error. I just tested it in a quick form and it works as expected.

Two questions:
1 - What is the data type of the column [DOB].
If it isn't type DateTime, you may need to convert it to DateTime before passing it to the function; although I would expect to see a TypeMismatch error.
2 - Are you sure the [DOB] column contains data?
I get #Name to appear on the form when my date_of_birth column is null.

 

[MADDPM]

Hi Robert,

I spoke too soon. The code works find except it seems to be ignoring the "DOD" - date of death column when a date is actually entered.

In other words: Date of Birth: 19-JUL-1960
Date of Death: 19-JUL-1961
Should result in 1 year.
However, my control ignores the DOD and results in a value of 48 Years, 3 Months, and 24 Days.

You previously stated, "You aren't passing in the non-optional date_of_birth value", - perhaps the DOD needs to be passed in also? If so, please let me know how, what the value of the control should be.

Many thanks!

 

[randy700]

Just as it states in Michael Red's comments, the DOD argument is OPTIONAL. If you omit it, the code will use the current date. If you want to pass a DOD value, you need to include it:

=basDOB2AgeExt([DOB])        'no DOD value passed, use current date.
=basDOB2AgeExt([DOB],[DOD])  'calculate using DOB and DOD values.

Randy

 

[MADDPM]

I'm confused . . .

I thought the if statement was supposed to handle that?

If (DOD = -1) Then 'Check for (Optional Date to Check against)
DOD = Date 'If Not Supplied, Assume Today
End If

No?

 

[randy700]

That's correct. If you do not pass the optional DOD value, the code will use the current date. If you want it to use a different (DOD) date, you must provide it.

The code sets DOD to a default value of -1 and checks (if statement) to see if you have changed it. If the value is still -1, today's date is assigned. If you provided a date, the if statement is bypassed.


Randy

 

[MADDPM]

In any event, =basDOB2AgeExt([DOB],[DOD]) does not work. It returns an error of #Error.

 

[ck1999]

MADDPM,

I do not know if you realize it but you changed from MichaelRed's code

asof to [DOD]

maybe you need to go back to his code.

ck1999

 

[PHV]

What about this ?
=basDOB2AgeExt([DOB],Nz([DOD],-1))

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[MichaelRed]

PHV only two args to the function.

MADPM
I generally post both threads and faqs to illustrate an approach to a soloution, this often / usually / (always?) means leaving out some of hte more mundane details, such as error checking and trapping. In a general sense, the function works to illustrate the process of returning more than one value to the calling program. It is, in this case, somewhat 'prettified' to return the multiple calculations in a single string, with some fixed text which would permit the user to parse the test and seperate the indicidual elements of the calculation (Years, Months and Days). The original modification and your somewhat trivial modification both work in the general sense, so the 'error's you are receiving are likely to be in the data (calling arguments) being suppllied.

While there are several approaches to parseing the data to validate the information, perhaps one of the simplest would be to run some simple select queries on the source fields to identify all records where they may not be (valid) dates.

Please utilize the ubiquitous help with the term IsDate and validate the source data (for both DOB and DOD.



MichaelRed

 

[PHV]

PHV only two args to the function
????

 

[MADDPM]

Hi all,

Actually, the end of the story and isolation of the problem was answered in a separate thread by Remou - his solution works perfectly:

Remou (TechnicalUser) 13 Nov 08 16:19
The -1 comes from the parameters:

Optional DOD As Date = -1

If you always wish to pass DOB,DOD you can use Nz to invoke the -1 case:

=basDOB2AgeExt([DOB],Nz([DOD],-1))

You may wish to provide for a null DOB.

 

[MichaelRed]

OOps ... sorry ... missed the enclosing parens on the Nz



MichaelRed