Solved: Age calculation

[fiza]

Hi Anyone!
I'm using the following afterupdate event to calculate the age when I write the date of birth. I need help to modify the code so that If a date less than a year is entered the age to be months and a date less than a week is entered it to be as days.

Private Sub txtDateOfBirth_AfterUpdate()
  Dim d1 As Date
  Dim d2 As Date
  Dim Age As Integer
  If Not IsDate(Me.txtDateofBirth.Value) Then
    MsgBox "The Date box must contain a date.", vbExclamation, "Customer Registration"
    Me.txtAge = ""
  Else
    d1 = CDate(Me.txtDateofBirth)
    d2 = Date
    Age = Year(d2) - Year(d1)
    If Month(d2) < Month(d1) Or (Month(d2) = Month(d1) And Day(d2) < Day(d1)) Then
      Age = Age - 1
    End If
    Me.txtAge = Age
  End If
End Sub

Regards
fiza

[Mis_Sailesh]

Hi,
Can you please elaborate with example?

[fiza]

I have attached the sample file for your reference. You can see that after you write the date of birth in the first textbox & move to the next text box the age is displayed in it. But the text box does not say whether the age is years, months or days.

what I want is the age to be displayed in its units.

Say or example if the date of birth is 02/01/2010 I want the age to be 3months.

if its 18/01/1983 I want the text that appears in the age textbox to be 27 years.

I hope I have made my question clear.

[Bob Phillips]

[vba]

Private Sub txtDateOfBirth_AfterUpdate()
Const DATE_FORMULA As String = _
"DATEDIF(<d1>,<d2>,""Y"")&"" years ""&DATEDIF(<d1>,<d2>,""YM"")&"" months"""
Dim d1 As Date
Dim d2 As Date
Dim Age As Integer
If Not IsDate(Me.txtDateOfBirth.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Recipient Registration"
Me.txtAge = ""
Else
d1 = CDate(Me.txtDateOfBirth)
d2 = Date
Me.txtAge = Application.Evaluate(Replace(Replace(DATE_FORMULA, "<d1>", CLng(d1)), "<d2>", CLng(d2)))
End If
End Sub
[/vba]

[GTO]

Probably not as good, haven't tried Bob's yet :-)

Option Explicit
    
Private Sub txtDateOfBirth_AfterUpdate()
Dim Period As String
    
    If Not IsDate(Me.txtDateOfBirth.Value) Then
        MsgBox "The Date box must contain a date.", vbExclamation, "Recipient Registration"
        Me.txtAge = ""
    Else
        Me.txtAge = AgeCalc(CDate(Me.txtDateOfBirth), Period) & Chr(32) & Period
    End If
End Sub
    
Function AgeCalc(DOB As Date, Period As String) As Long
    
    Select Case Date - DOB
    Case Is > 365
        AgeCalc = Int((Date - DOB) / 365)
        Period = IIf(AgeCalc >= 2, "Years", "Year")
        
    Case Is > 30
        AgeCalc = Int((Date - DOB) / 30)
        Period = IIf(AgeCalc >= 2, "Months", "Month")
    Case Is > 7
        AgeCalc = Int((Date - DOB) / 7)
        Period = IIf(AgeCalc >= 2, "Weeks", "Week")
    Case Else
        AgeCalc = Date - DOB
        Period = IIf(AgeCalc >= 2, "Days", "Day")
    End Select
End Function

Edit: ACK! missed a slight bit...

[Mis_Sailesh]

Hi Fiza,
Hope you have got your solution?
If so please mark your thread as solved, else please let us know the further help you are looking at?

[fiza]

thanks for the help guys. my problem is finally solved