• Home
 · 
• Math/Dates
 · 
• Gets the Accurate Age!

Gets the Accurate Age!

Gets the Accurate Age!

API Declarations


' Here is a code that can help you.
' Add it to your BAS file.
'
' Sample Usage:
' If you have already copied the code below
' to your BAS file then press Ctrl-G and type
' the following codes.
' ? GetAccurateAge(#01/01/1960#, Date())
'
' If the month is not yet the current month then
' do not advance the age.
' is on Oct. 15 1970 and
'
' ? GetAccurateAge(#10/15/1970#, Date())
'
' If a person is born on Oct. 15, 1970 and
' it is not yet his birthday then he will still
' be 34 yrs not 35 yrs. Accurate Age!




Rate Gets the Accurate Age!

• 1
• 2
• 3
• 4
• 5

(1(1 Vote))

   ByVal dteto As Date) As Integer
' **************************************************
' Description  : Gives you the accurate age of a person.
' Author       : Ulysses R.Gotera
' e-mail       : [email protected]
' Note         : You can view my profile at friendster.
' **************************************************
On Error GoTo ErrHandler
   Dim intFromDay As Integer, intFromMon As Integer, intFromYr As Integer
   Dim intToDay As Integer, intToMon As Integer, intToYr As Integer
   Dim intResultAge As Integer
    
   intFromYr = Year(dtefrom)
   intFromMon = Month(dtefrom)
   intFromDay = Day(dtefrom)
   
   intToYr = Year(dteto)
   intToMon = Month(dteto)
   intToDay = Day(dteto)
   
   If intFromYr <= intToYr Then
      intResultAge = intToYr - intFromYr
   Else
      GetAccurateAge = -1: Exit Function ' invalid value
   End If
   
   If intFromMon <= intToMon Then
         If (intFromMon = intToMon) And (intFromDay > intToDay) Then
            intResultAge = intResultAge - 1
         Else
            intResultAge = intResultAge
         End If
   Else
      intResultAge = intResultAge - 1
   End If
   GetAccurateAge = intResultAge
      
GetAccurateAgeExit:
   Exit Function
   
ErrHandler:
   GetAccurateAge = -1
End Function