how to calculate age in Userform

Shaikh Aziz

New Member
Joined
Dec 18, 2020
Messages
28
Office Version
  1. 2007
Platform
  1. Windows
Dear Team,

I want to calculate age based on Birthdate & Current Date in userform1,
i have already created below 3 components,
list of combobox1, 2 & 3 for birth date month & year respectively, __done
Textbox1 for currentDate,__done
& textbox2 for age calculating. ???__question

Please help for sorting codes in vba userform,

thanks for watching thread.
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

NoSparks

Well-known Member
Joined
Mar 15, 2013
Messages
1,342
Office Version
  1. 2010
Platform
  1. Windows
Using a UDF found and tucked away years ago...
With a test userform I set up, 2 text boxes, 3 combo boxes and 1 command button.
this in the user form module
VBA Code:
Option Explicit

Private Sub UserForm_Initialize()
' form set up
    Me.TextBox1 = Format(Date, "dd/mm/yyyy")
    Me.ComboBox1.List = [row(1:31)]
    Me.ComboBox2.List = Application.GetCustomListContents(4)
    Me.ComboBox3.List = [row(1925:2021)]
End Sub

Private Sub AgeCalc_Click()
' button to fill in calculated age
    Dim birth As Date
birth = DateSerial(Me.ComboBox3, Month(DateValue("1 " & Me.ComboBox2 & " 2021")), Me.ComboBox1)
Me.TextBox2 = Diff2Dates("ymd", birth, Date)
End Sub

and this in a standard module
VBA Code:
Option Explicit

'***************** Code Start **************
Public Function Diff2Dates(Interval As String, Date1 As Variant, Date2 As Variant, _
Optional ShowZero As Boolean = False) As Variant
'Author:    ? Copyright 2001 Pacific Database Pty Limited
'           Graham R Seach MCP MVP gseach@pacificdb.com.au
'           Phone: +61 2 9872 9594  Fax: +61 2 9872 9593
'           This code is freeware. Enjoy...
'           (*) Amendments suggested by Douglas J. Steele MVP
'
'Description:   This function calculates the number of years,
'               months, days, hours, minutes and seconds between
'               two dates, as elapsed time.
'
'Inputs:    Interval:   Intervals to be displayed (a string)
'           Date1:      The lower date (see below)
'           Date2:      The higher date (see below)
'           ShowZero:   Boolean to select showing zero elements
'
'Outputs:   On error: Null
'           On no error: Variant containing the number of years,
'               months, days, hours, minutes & seconds between
'               the two dates, depending on the display interval
'               selected.
'           If Date1 is greater than Date2, the result will
'               be a negative value.
'           The function compensates for the lack of any intervals
'               not listed. For example, if Interval lists "m", but
'               not "y", the function adds the value of the year
'               component to the month component.
'           If ShowZero is True, and an output element is zero, it
'               is displayed. However, if ShowZero is False or
'               omitted, no zero-value elements are displayed.
'               For example, with ShowZero = False, Interval = "ym",
'               elements = 0 & 1 respectively, the output string
'               will be "1 month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

   Dim booCalcYears As Boolean
   Dim booCalcMonths As Boolean
   Dim booCalcDays As Boolean
   Dim booCalcHours As Boolean
   Dim booCalcMinutes As Boolean
   Dim booCalcSeconds As Boolean
   Dim booCalcWeeks As Boolean
   Dim booSwapped As Boolean
   Dim dtTemp As Date
   Dim intCounter As Integer
   Dim lngDiffYears As Long
   Dim lngDiffMonths As Long
   Dim lngDiffDays As Long
   Dim lngDiffHours As Long
   Dim lngDiffMinutes As Long
   Dim lngDiffSeconds As Long
   Dim lngDiffWeeks As Long
   Dim varTemp As Variant

   Const INTERVALS As String = "dmyhnsw"

'Check that Interval contains only valid characters
   Interval = LCase$(Interval)
   For intCounter = 1 To Len(Interval)
      If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
         Exit Function
      End If
   Next intCounter

'Check that valid dates have been entered
   If IsNull(Date1) Then Exit Function
   If IsNull(Date2) Then Exit Function
   If Not (IsDate(Date1)) Then Exit Function
   If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
   If Date1 > Date2 Then
      dtTemp = Date1
      Date1 = Date2
      Date2 = dtTemp
      booSwapped = True
   End If

   Diff2Dates = Null
   varTemp = Null

'What intervals are supplied
   booCalcYears = (InStr(1, Interval, "y") > 0)
   booCalcMonths = (InStr(1, Interval, "m") > 0)
   booCalcDays = (InStr(1, Interval, "d") > 0)
   booCalcHours = (InStr(1, Interval, "h") > 0)
   booCalcMinutes = (InStr(1, Interval, "n") > 0)
   booCalcSeconds = (InStr(1, Interval, "s") > 0)
   booCalcWeeks = (InStr(1, Interval, "w") > 0)

'Get the cumulative differences
   If booCalcYears Then
      lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
              IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
      Date1 = DateAdd("yyyy", lngDiffYears, Date1)
   End If

   If booCalcMonths Then
      lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
              IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
      Date1 = DateAdd("m", lngDiffMonths, Date1)
   End If

   If booCalcWeeks Then
      lngDiffWeeks = Abs(DateDiff("w", Date1, Date2)) - _
              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
      Date1 = DateAdd("ww", lngDiffWeeks, Date1)
   End If

   If booCalcDays Then
      lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
              IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
      Date1 = DateAdd("d", lngDiffDays, Date1)
   End If

   If booCalcHours Then
      lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
              IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
      Date1 = DateAdd("h", lngDiffHours, Date1)
   End If

   If booCalcMinutes Then
      lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
              IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
      Date1 = DateAdd("n", lngDiffMinutes, Date1)
   End If

   If booCalcSeconds Then
      lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
      Date1 = DateAdd("s", lngDiffSeconds, Date1)
   End If

   If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
      varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
   End If

   If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
      If booCalcMonths Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
      End If
   End If

   If booCalcWeeks And (lngDiffWeeks > 0 Or ShowZero) Then
      If booCalcWeeks Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffWeeks & IIf(lngDiffWeeks <> 1, " weeks", " week")
      End If
   End If

   If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
      If booCalcDays Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
      End If
   End If

   If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
      If booCalcHours Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
      End If
   End If

   If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
      If booCalcMinutes Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
      End If
   End If

   If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
      If booCalcSeconds Then
         varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
                   lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
      End If
   End If

   If booSwapped Then
      varTemp = "-" & varTemp
   End If

   Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
   Exit Function

Err_Diff2Dates:
   Resume End_Diff2Dates

End Function
'************** Code End *****************
 
Solution
Learn Excel from Bill Jelen

Understanding data is crucial, and the easiest place to start is with Microsoft Excel.

Forum statistics

Threads
1,151,578
Messages
5,765,205
Members
425,267
Latest member
bishopc22

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top