Shoutbox

its only math mate

work out age, how many months + days till birthday

code:

---

Function YMD(StartDate As Date, EndDate As Date) As String
Dim TempDate As Date
Dim NumOfYears As Long
Dim NumOfMonths As Long
Dim NumOfWeeks As Long
Dim NumOfDays As Long
Dim NumOfHMS As Double
Dim TSerial1 As Double
Dim TSerial2 As Double
NumOfYears = DateDiff("yyyy", StartDate, EndDate)
TSerial1 = TimeSerial(Hour(StartDate), _
Minute(StartDate), Second(StartDate))
TSerial2 = TimeSerial(Hour(EndDate), _
Minute(EndDate), Second(EndDate))
NumOfHMS = 24 * (TSerial2 - TSerial1)
If NumOfHMS < 0 Then
NumOfHMS = NumOfHMS + 24
EndDate = DateAdd("yyyy", -1, EndDate)
End If
StartDate = DateSerial(Year(EndDate), _
Month(StartDate), Day(StartDate))
If StartDate > EndDate Then
StartDate = DateAdd("d", -1, StartDate)
NumOfYears = NumOfYears - 1
End If
NumOfMonths = DateDiff("m", StartDate, EndDate)
StartDate = DateSerial(Year(EndDate), _
Month(EndDate), Day(StartDate))
If StartDate > EndDate Then
StartDate = DateAdd("m", -1, StartDate)
NumOfMonths = NumOfMonths - 1
End If
NumOfDays = Abs(DateDiff("d", StartDate, EndDate))
YMD = CStr(NumOfYears) & " year" & _
IIf(NumOfYears = 1, "", "s")
YMD = YMD & ", "
YMD = YMD & CStr(NumOfMonths) & " month" & _
IIf(NumOfMonths = 1, "", "s")
YMD = YMD & ", "
YMD = YMD & CStr(NumOfDays) & " day" & _
IIf(NumOfDays = 1, "", "s")
End Function

---