Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Public Function CalculateAge(DOB As Date) As Integer
Dim WorkDate As Date
Dim RawAge As Integer
RawAge = DateDiff("yyyy", DOB, Date)
WorkDate = DateSerial(Year(Date), month(DOB), Day(DOB))
CalculateAge = RawAge + (Date < WorkDate) '(Date < WorkDate) = 0 or -1
End Function
Function CalculateLongAge(DOB As Date, CurDate As Date) As String
Dim Y As Integer
Dim M As Integer
Dim D As Integer
Dim Temp1 As Date
Temp1 = DateSerial(Year(CurDate), month(DOB), Day(DOB))
Y = Year(CurDate) - Year(DOB) + (Temp1 > CurDate)
M = month(CurDate) - month(DOB) - (12 * (Temp1 > CurDate))
D = Day(CurDate) - Day(DOB)
If D < 0 Then
M = M - 1
D = Day(DateSerial(Year(CurDate), month(CurDate) + 1, 0)) + D + 1
End If
CalculateLongAge = Y & " years " & M & " months " & D & " days"
End Function
Public Function CalculateAge(DOB As Date, DOP As Date) As Integer
Dim WorkDate As Date
Dim RawAge As Integer
RawAge = DateDiff("yyyy", DOB, DOP)
WorkDate = DateSerial(Year(DOP), month(DOB), Day(DOB))
CalculateAge = RawAge + (DOP< WorkDate) '(Date < WorkDate) = 0 or -1
End Function
So to use the first function.Age = CalculateAge(DOB, DOP)
Public Function Years( _
ByVal datDate1 As Date, _
ByVal datDate2 As Date, _
Optional ByVal booLinear As Boolean) _
As Integer
' Returns the difference in full years 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 year counts.
' For a given datDate1, if datDate2 is decreased step wise one year 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 years to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2000-11-03. Cactus Data ApS, CPH.
' 2000-12-16. Leap year correction modified to be symmetrical.
' Calculation of intDaysDiff simplified.
' Renamed from YearsDiff() to Years().
' 2000-12-18. Introduced cbytMonthDaysMax.
' 2007-06-22. Version 2. Complete rewrite.
' Check for month end of February performed with DateAdd()
' after idea of Markus G. Fischer.
Dim intDiff As Integer
Dim intSign As Integer
Dim intYears As Integer
' Find difference in calendar years.
intYears = DateDiff("yyyy", datDate1, datDate2)
' For positive resp. negative intervals, check if the second date
' falls before, on, or after the crossing date for a full 12 months 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("yyyy", intYears, datDate1), datDate2))
intDiff = Abs(intSign < 0)
Else
intSign = Sgn(DateDiff("d", DateAdd("yyyy", -intYears, datDate2), datDate1))
If intSign <> 0 Then
' Offset negative count of years to continuous sequence if requested.
intDiff = Abs(booLinear)
End If
intDiff = intDiff - Abs(intSign < 0)
End If
' Return count of years as count of full 12 months periods.
Years = intYears - intDiff
End Function
/gustavIf you are experiencing a similar issue, please ask a related question
Join the community of 500,000 technology professionals and ask your questions.