Link to home
Start Free TrialLog in
Avatar of SilviaAtkins
SilviaAtkins

asked on

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

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
Avatar of Alan Warren
Alan Warren
Flag of Philippines image

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



Avatar of SilviaAtkins
SilviaAtkins

ASKER

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
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
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
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.
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
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


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








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
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
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
You have two code procedures called Form_Current

need to lose one :)

Alan
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
Alan
After typing a test date
Label is showing -.6

Sil
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
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
Hi Sil

I'm missing something :)

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

Alan
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
   
Hi Sil,

you have a field called DOB   yes??

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

Returns: 9.3

Alan
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
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
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

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 :)
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
ASKER CERTIFIED SOLUTION
Avatar of Alan Warren
Alan Warren
Flag of Philippines image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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