Auto generate age with months and days using vb 6.0

Isaac renthlei
Isaac renthlei used Ask the Experts™
on
How to auto generate aperson's age using vb 6.0 as soon as the dob is enter using the datetimepicker .
I want details of coding as well as video .

And please include the years as well as months and days of the person's age
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Most Valuable Expert 2015
Distinguished Expert 2018
Commented:
Here is how to calculate the exact age at today's date:

Public Function AgeSimple( _
  ByVal datDateOfBirth As Date) _
  As Integer

' Returns the difference in full years from datDateOfBirth to current date.
'
' Calculates correctly for:
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'
' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of years to dates of Feb. 29.
' when the resulting year is a common year.
' After an idea of Markus G. Fischer.
'
' 2007-06-26. Cactus Data ApS, CPH.

  Dim datToday  As Date
  Dim intAge    As Integer
  Dim intYears  As Integer
    
  datToday = Date
  ' Find difference in calendar years.
  intYears = DateDiff("yyyy", datDateOfBirth, datToday)
  If intYears > 0 Then
    ' Decrease by 1 if current date is earlier than birthday of current year
    ' using DateDiff to ignore a time portion of datDateOfBirth.
    intAge = intYears - Abs(DateDiff("d", datToday, DateAdd("yyyy", intYears, datDateOfBirth)) > 0)
  End If
  
  AgeSimple = intAge
  
End Function

Open in new window


Years, months, and days can be found like this:

Public Function YearsMonthsDays( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  Optional ByRef lngYears As Long, _
  Optional ByRef lngMonths As Long, _
  Optional ByRef lngDays As Long) _
  As String
  
' Returns the difference in years, months, and days between datDate1 and datDate2.
'
' Calculates correctly for:
'   negative differences
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'   negative date/time values (prior to 1899-12-29)
'
' Gustav Brock, Cactus Data ApS.
' 2010-03-30.

  ' Count of months in a calendar year.
  Const cintMonths  As Integer = 12
  
  Dim datDateMonth  As Date
  Dim intDays       As Integer
  
  ' No special error handling.
  On Error Resume Next
  
  lngMonths = Months(datDate1, datDate2)
  
  datDateMonth = DateAdd("m", lngMonths, datDate1)
  lngDays = DateDiff("d", datDateMonth, datDate2)
  intDays = Sgn(lngDays)
  If intDays <> 0 Then
    If intDays <> Sgn(DateDiff("d", datDate1, datDate2)) Then
      lngDays = 0
    End If
  End If
  
  lngYears = lngMonths \ cintMonths
  lngMonths = lngMonths Mod cintMonths
  
  YearsMonthsDays = CStr(lngYears) & " year(s), " & CStr(lngMonths) & " month(s), " & CStr(lngDays) & " day(s)"

End Function


Public Function Months( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  Optional ByVal booLinear As Boolean) _
  As Integer

' Returns the difference in full months between datDate1 and datDate2.
'
' Calculates correctly for:
'   negative differences
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'   negative date/time values (prior to 1899-12-29)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of month counts.
' For a given datDate1, if datDate2 is decreased stepwise one month from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
'   3, 2, 1, 0,  0, -1, -2
' If booLinear is True, the sequence will be:
'   3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDate1 and datDate2 will return
' results of same absolute Value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDate1 and datDate2 will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().

' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of months to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2010-03-30. Cactus Data ApS, CPH.

  Dim intDiff   As Integer
  Dim intSign   As Integer
  Dim intMonths As Integer
  
  ' Find difference in calendar months.
  intMonths = DateDiff("m", datDate1, datDate2)
  ' For positive resp. negative intervals, check if the second date
  ' falls before, on, or after the crossing date for a 1 month period
  ' while at the same time correcting for February 29. of leap years.
  If DateDiff("d", datDate1, datDate2) > 0 Then
    intSign = Sgn(DateDiff("d", DateAdd("m", intMonths, datDate1), datDate2))
    intDiff = Abs(intSign < 0)
  Else
    intSign = Sgn(DateDiff("d", DateAdd("m", -intMonths, datDate2), datDate1))
    If intSign <> 0 Then
      ' Offset negative count of months to continuous sequence if requested.
      intDiff = Abs(booLinear)
    End If
    intDiff = intDiff - Abs(intSign < 0)
  End If
  
  ' Return count of months as count of full 1 month periods.
  Months = intMonths - intDiff
  
End Function

Open in new window

The videos you must create yourself.

/gustav
Assuming you have DateTimePicker (DTPicker1) and command button (Command1) on your form.
Private Sub Command1_Click()
  Dim y, m, d
  GetAge DTPicker1.Value, y, m, d
  MsgBox "Age = " & y & "years, " & m & " months, " & d & " days."
End Sub
Private Sub GetAge(ByVal dtBirth As Date, years, months, days)
   months = DateDiff("m", dtBirth, Date)
   days = DateDiff("d", DateAdd("m", months, dtBirth), Date)
   If days < 0 Then
      months = months - 1
      days = DateDiff("d", DateAdd("m", months, dtBirth), Date)
   End If
   years = months \ 12
   months = months Mod 12
End Sub

Open in new window

Most Valuable Expert 2015
Distinguished Expert 2018

Commented:
Problem seems solved.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial