by Ulysses R. Gotera (9 Submissions)
Category: Math/Dates
Compatability: Visual Basic 5.0
Difficulty: Unknown Difficulty
Originally Published: Fri 29th July 2005
Date Added: Mon 8th February 2021
Rating: (1 Votes)
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!
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