Solved

How to calculate age in months and years between 2 user entered dates - step by step what code does, where to put it and how to activate it

Posted on 2004-04-11
26
1,845 Views
Last Modified: 2007-12-19
Hi All

I am really getting frustrated trying to solve the following problem –I am also new to code.

Have created an access data base that needs to calculate age from date of birth with years and months
I used the following code in the Gereral Decs (a mate sent it to me as is)

Option Explicit

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 AgeMonths(ByVal StartDate As String) 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

In the form I have 6 text boxes in the agetxt I have entered the following code
=Age([txtDOB]) & " years " & AgeMonths([txtDOB]) & " months"
Returns eg 3 years 6 month (depend on the DOB)
Appears to work fine

Problem arises when I try to calculate between DOB and Date of test1 – I need the age in years and months again.
I have 4 different test dates to DOB calculations that need to be done

I
a)Don’t know if I can utilise the above code for the DOB to testdate caculations
b) Am so new to code I need step by step guidance
c) Have been trying to work out an answer to this for so long that I am now totally confused
0
Comment
Question by:SilviaAtkins
  • 13
  • 12
26 Comments
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10803550
Hi Silvia,

I usually just store the DOB value in a table and then run a query like this:
To test this:
Create a new table:
tblStudents
Fields ID(Autonumber), DOB(Date/Time)

Add  records:
DOB                      ID
12/04/1977      1
12/05/1978      2
12/06/1979      3

Create a new query and choose View > SQL from the menu and paste the following sql into the query designer

SELECT tblStudents.DOB, Format(DateAdd("s",DateDiff("s",[DOB],(Now())),(Date())),"yy mm") AS Age FROM tblStudents;

Returns:
DOB                      Age
12/04/1977      31 04
12/05/1978      30 03
12/06/1979      29 02



Alan



0
 

Author Comment

by:SilviaAtkins
ID: 10803686
Hi Alan

Sorry I proberly didn't make myself clear enough
The code I posted gives the date of birth to current and I am happy with it.
Probem is when the user enters a date eg testdate1 and then I need to get the age from DOB to testdate1 - This is what I need help with.

Tbl Student with feilds
ID   DOB      Testdate1         Testdate2           Testdate3               Testdate4
the form then has
lblAge      lblAgeAtTest1       lblAgeAtTest2      lblAgeAtTest3         lblAgeAtTest4

The lables display the age for the caculations

Hope you can help me with the answer as this has been driving me crazy

Silvia
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10803740
Hi Silvia,

Re: Problem arises when I try to calculate between DOB and Date of test1 – I need the age in years and months again.

can you tell me something about test1

eg...

ControlType: textbox
ControlSource: unbound
Sample of value: 3 years 6 month

Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10803858
Hi Alan

Hope this is what you need

DateOfTest1
ControlType: textbox
ControlSource: Testdate1
Datatype:  Date/Time (shortdate)
Sample of input: 20/12/1995

The form is where the user enters all info - they will not be able to access the table
ID = AutoNumber
All the date fields come from the underling tables and are text boxes with Datatype:  Date/Time (shortdate)

Rest of info user enters

TblStudent with fields
ID   DOB      Testdate1         Testdate2           Testdate3               Testdate4

the form then has
ID   DOB      Testdate1         Testdate2           Testdate3               Testdate4
lblAge      lblAgeAtTest1       lblAgeAtTest2      lblAgeAtTest3         lblAgeAtTest4

3 years 6 month or 3.6 is what I hoped will display on the corresponding lables

Silvia
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10803936
Hi Sylvia,


This may be OK for you.

Private Sub Testdate1_AfterUpdate()
  Dim xdate As Date
  xdate = CDate(Testdate1)
  Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")
End Sub

returns:
12/06/1980 > 23.8


Similar for the other TestdateX fields.
0
 
LVL 11

Expert Comment

by:sparab
ID: 10804332
Dim d As Integer
Dim dd, mm, yy As Integer

Dim result As String
  Dim xdate1 As Date
  Dim xdate2 As Date
  xdate1 = #2/4/2003# 'Birth date
  xdate2 = #1/4/2004# 'Current Date
  yy = DateDiff("yyyy", xdate1, xdate2)
If yy > 1 Then
    result = result & yy & " Years"
ElseIf yy = 1 Then
    result = result & yy & " Year"
End If
mm = DateDiff("m", xdate1, xdate2)
If mm < 12 Then
    mm = 12 - mm
Else
    mm = mm - ((yy) * 12)
End If
If mm > 1 Then
    result = result & mm & " Months"
ElseIf mm = 1 Then
    result = result & mm & " Month"
End If

dd = DateDiff("d", xdate1, xdate2)
If dd < 365 Then
    dd = 365 - dd
Else
    dd = dd - ((yy) * 365)
End If
If dd <> 0 And dd <> 31 Then
result = result & dd & " Days"
ElseIf dd <> 0 And dd <> 31 Then
result = result & dd & " Day"
End If
MsgBox result
0
 

Author Comment

by:SilviaAtkins
ID: 10810291
Hi again Alan
I must be missing something - tried to get the piece of code to work
I
a. pasted the code in the forms general decs
b. checked the properties for both the Testdate1 textbox (where the test date is entered by user) and the Label - lblAgeAtTest1 - both as specified
c. entered a test date
Nothing happened - Age didn't appear on the Label and no error

Any ideas would be appreciated
Regards Silvia

Hi sparab
I need instructions as to what and where code goes. Please read original help required.
The code looks like it gives age from DOB to current system date - I need age from DOB to user entered test date.

Regards Silvia


0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10810611
Hi Sylvia,

Open the form in design view, click on Testdate1 textbox then choose View > Properties
Ensure that the event procedure for AfterUpdate has value of [Event Procedure]
Click the build button alongside, looks like [...]   Your code should be  there.

we may need to trigger from Form Current too like this:

Private Sub Form_Current()
  Dim xdate As Date
 
  xdate = CDate(Testdate1)
  Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")

  ' if this works OK repeat the process here for the other controls
  ' Like this
  '  xdate = CDate(Testdate2)
  '  Me.lblAgeAtTest2.Caption = Format((Date - xdate) / 365, "##.#")
  ' dont forget to call Form current from each controls after update
End Sub

Then your After update for can be modified to:

Private Sub Testdate1_AfterUpdate()
  call Form_Current()
End Sub


Alan








0
 

Author Comment

by:SilviaAtkins
ID: 10810935
Hi Alan
    Opened the form in design view, clicked on Testdate1 textbox then View > Properties
AfterUpdate had value of [Event Procedure] I click the build button and the code  was there.

I selected the form and in the Private Sub Form_Current()
pasted the code again. I got error

On debug

Private Sub Form_Current()
 Dim xdate As Date
 
  xdate = CDate(TestDate1)      'THIS WAS THE HIGHLIGHTED CODE
  Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")

End Sub
Really strange thing is though it affects the label lblAge - which is the original DOB to current date output display.

Are we winning do you think?  :)
I am sure I have bitten off a little more than I can chew here - Thank god I found you

Silvia
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811004
Hi Sylvia,

Lets see if we can catch the error

Private Sub Form_Current()
  On Error GoTo ReportError

  Dim xdate As Date
 
  xdate = CDate(TestDate1)      'THIS WAS THE HIGHLIGHTED CODE
  Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")


ExitProcedure:
  On Error Resume Next
  Exit Sub

ReportError:
  Dim msg As String
   msg = "Error in Form_Current()" _
    & vbCr & "Error number " & CStr(Err.Number) _
    & " was generated by " & Err.Source _
    & vbCr & Err.Description
  MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
  Resume ExitProcedure
 

End Sub


Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10811108
Alan
The paper clip :) shows a message

The expression On Current you entered as the event property setting produced the following error: Ambiguous name detected: Form_Current.
The expression maynot result in the name of a macro, the name of a user defined function, or [event procedure]
There may have been an error evualulating, the function, event or macro.

Silvia
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811132
You have two code procedures called Form_Current

need to lose one :)

Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10811189
I am now getting error-standard Access msg box
Error in Form_Current
Error number was generated be What Is Required (this is the name of the database I am using for testing what we are doing)
Invalid use of null

??? Sil
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 

Author Comment

by:SilviaAtkins
ID: 10811202
Alan
After typing a test date
Label is showing -.6

Sil
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811217
TestDate1 is null  

nearly got it...

Replace this code:
 Dim xdate As Date
 
  xdate = CDate(TestDate1)      'THIS WAS THE HIGHLIGHTED CODE
  Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")


With this code:


  Dim xdate As Date
  If nz(TestDate1,"") <> "" then
    If IsDate(TestDate1) then
      xdate = CDate(TestDate1)      'THIS WAS THE HIGHLIGHTED CODE
      Me.lblAgeAtTest1.Caption = Format((Date - xdate) / 365, "##.#")
    End If
  End If


Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10811538
Alan

replaced code as you specified - No Errors :) :)
I typed in
DOB = 5/08/1995
Date of test = 5/11/2004
Lable = -.6     Should be 9.3

Silvia
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811589
Hi Sil

I'm missing something :)

if someone was born on 5/11/2004
 then they are -.6 yrs old

Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10811713
Hi Alan

If they were born on 5/08/1995
And the test date is 5/11/2004

The kid has to be 9.3 at the date of the test

If they were to be born on the 5/11/2004 then yes at the date of the test -.6

I need from birthdate to testdate.

Regards Sil
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811780
   
Hi Sil,

you have a field called DOB   yes??

Me.lblAgeAtTest1.Caption = Format((xdate - DOB) / 365, "##.#")

Returns: 9.3

Alan
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10811880
Hi Sylvia,

Ok, If you follow the naming convention you outlined previously this should do all in one go.

the form then has
ID   DOB      Testdate1         Testdate2           Testdate3               Testdate4
lblAge      lblAgeAtTest1       lblAgeAtTest2      lblAgeAtTest3         lblAgeAtTest4


Private Sub Form_Current()
  Dim xdate As Date
  Dim ctl As Control
  Dim sControlName As String
  Dim sLabel As String
 
  For Each ctl In Me.Controls
    If InStr(1, ctl.Name, "TestDate", vbTextCompare) > 0 Then
      If Nz(ctl, "") <> "" Then
        If IsDate(ctl) Then
          xdate = CDate(ctl)
          sLabel = "lblAgeAtTest" & Mid(ctl.Name, Len("TestDate") + 1, vbTextCompare)
          Me.Controls(sLabel).Caption = Format((xdate - DOB) / 365, "##.#")
        End If
      End If
    End If
  Next

End Sub


Regards Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10812112
Hi Alan

Do you wish to strangle me yet????
Using DOB - 6/01/1998
Testdate1 - 6/05/2000
I am getting 100.4 in lblAgeAtTest1 not 2.4

Testdate2 - 6/02/2002
lblAgeAtTest2 = nothing comes in

Same for other labels lblAgeAtTest3 & lblAgeAtTest4

 100.4 divided by 52 = 1.93 so it dos't appear to be weeks

Sil
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10812190
Hi Silvia,

Not turning violent yet, LOL

But I am a little confused because it is working on my machine here.

If this is not too huge a project, and the data not national security data, you are most welcome to zip it up and mail it to me, if you like. Just click my name above this comment to get to my profile, my email is in my profile. Just remove NOSPAM from the bogus mail address.

Failing that can you post the current contents of Form_Current() procedure

Alan

0
 

Author Comment

by:SilviaAtkins
ID: 10812449
Alan

zipped and on its way - this is the test database so no national security  problems.  LOL
the database that I need this for is to enter kids results from a series of tests the age at test date is currently work out manually then compared with an average. We are then targeting the kids that need extra support.

regards Sil :)
0
 
LVL 26

Expert Comment

by:Alan Warren
ID: 10812607
Hi Silvia,

Should be in your inbox about now.



Private Sub Form_Current()
  On Error GoTo ReportError
 
  Dim xdate As Date
  Dim ctl As Control
  Dim sControlName As String
  Dim sLabel As String
 
  ' If no dob entered get out of this sub.
  If Nz(txtDOB, "") = "" Then: Exit Sub
 
  Me.txtAge = Age([txtDOB]) & " years " & AgeMonths([txtDOB]) & " months"
 
  For Each ctl In Me.Controls
    If InStr(1, ctl.Name, "TestDate", vbTextCompare) > 0 Then
      If Nz(ctl, "") <> "" Then
        If IsDate(ctl) Then
          xdate = CDate(ctl)
          sLabel = "lblAgeAtTest" & Mid(ctl.Name, Len("TestDate") + 1, vbTextCompare)
          Me.Controls(sLabel).Caption = Format((xdate - txtDOB) / 365, "##.#")
        End If
      Else
        sLabel = "lblAgeAtTest" & Mid(ctl.Name, Len("TestDate") + 1, vbTextCompare)
        Me.Controls(sLabel).Caption = "Unknown"
      End If
    End If
  Next
 
ExitProcedure:
  On Error Resume Next
  Exit Sub

ReportError:
  Dim msg As String
   msg = "Error in Form_Current()" _
    & vbCr & "Error number " & CStr(Err.Number) _
    & " was generated by " & Err.Source _
    & vbCr & Err.Description
  MsgBox msg, vbExclamation + vbMsgBoxHelpButton, "Error", Err.HelpFile, Err.HelpContext
  Resume ExitProcedure
 
End Sub

Private Sub Testdate1_AfterUpdate()
  Call Form_Current
End Sub

Private Sub TestDate2_AfterUpdate()
    Call Form_Current
End Sub

Private Sub TestDate3_AfterUpdate()
    Call Form_Current
End Sub

Private Sub TestDate4_AfterUpdate()
    Call Form_Current
End Sub

Private Sub txtDOB_AfterUpdate()
  Call Form_Current
End Sub



Alan
0
 
LVL 26

Accepted Solution

by:
Alan Warren earned 250 total points
ID: 10812729
Hi Silvia,

Set the enter key behavior property setting for all text fields to default.
And set the Tab Order, some of the fields are in wrong sequence.
Menu > View > Tab Order

Alan
0
 

Author Comment

by:SilviaAtkins
ID: 10816833
Hi Alan
You my friend are a genius. Thank you very much.
I will now be able to tackle the real one - Thakyou again

Regards Sil
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
Familiarize people with the process of utilizing SQL Server stored procedures from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Micr…
Familiarize people with the process of retrieving data from SQL Server using an Access pass-thru query. Microsoft Access is a very powerful client/server development tool. One of the ways that you can retrieve data from a SQL Server is by using a pa…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now