• Home
 · 
• Miscellaneous
 · 
• Various date functions including age calculation, number of days in month, leap year, etc.

Various date functions including age calculation, number of days in month, leap year, etc.

Various date functions including age calculation, number of days in month, leap year, etc.

Rate Various date functions including age calculation, number of days in month, leap year, etc.

• 1
• 2
• 3
• 4
• 5

(2(2 Vote))

'Age              Age in years.
'DaysInMonth      The number of days in the current month.
'DaysInMonth2     Alternate method.
'EndOfMonth       Returns the date for the last day of the current month.
'EndOfWeek        Returns the date for the last day in the current week.
'LastBusDay       Returns the date for the last business day (Mon-Fri)
'                 in the current month.
'LeapYear         Returns True or False if the year is a leap year.
'LeapYear2        Alternate method.
'NextDay          Returns the date for the next day (Sun...Sat) after the
'                 current date.
'NextDay1         Returns the date for the next day (Sun...Sat) on or
'                 after the current date.
'PriorDay         Returns the date for the last day (Sun...Sat) before
'                 the current date.
'PriorDay1        Returns the date for the last day (Sun...Sat) on or
'                 before the current date.
'StartOfMonth     Returns the date for the first day of the current
'                 month.
'StartOfWeek      Returns the date for the first day of the current week.


Function Age(ByVal Bdate As Date, ByVal DateToday As Date) As Long
' Doesn't handle negative date ranges i.e. Bdate > DateToday.
  If Month(DateToday) < Month(Bdate) _
  Or (Month(DateToday) = Month(Bdate) _
  And Day(DateToday) < Day(Bdate)) Then
    Age = Year(DateToday) - Year(Bdate) - 1
  Else
    Age = Year(DateToday) - Year(Bdate)
  End If
End Function

Function DaysInMonth(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
  Select Case Month(D)
    Case 2
      If LeapYear(Year(D)) Then
        DaysInMonth = 29
      Else
        DaysInMonth = 28
      End If
    Case 4, 6, 9, 11
      DaysInMonth = 30
    Case 1, 3, 5, 7, 8, 10, 12
      DaysInMonth = 31
  End Select
End Function

Function DaysInMonth2(ByVal D As Date) As Long
' Requires a date argument because February can change
' if it's a leap year.
  DaysInMonth2 = Day(DateSerial(Year(D), Month(D) + 1, 0))
End Function

Function EndOfMonth(ByVal D As Date) As Date
  EndOfMonth = DateSerial(Year(D), Month(D) + 1, 0)
End Function

Function EndOfWeek(ByVal D As Date) As Date
  EndOfWeek = D - Weekday(D) + 7
End Function

Function LastBusDay(ByVal D As Date) As Date
Dim D2 As Variant
  D2 = DateSerial(Year(D), Month(D) + 1, 0)
  Do While Weekday(D2) = 1 Or Weekday(D2) = 7
    D2 = D2 - 1
  Loop
  LastBusDay = D2
End Function

Function LeapYear(ByVal YYYY As Long) As Boolean
  LeapYear = YYYY Mod 4 = 0 _
             And (YYYY Mod 100 <> 0 Or YYYY Mod 400 = 0)
End Function

Function LeapYear2(ByVal YYYY As Long) As Boolean
  LeapYear2 = Month(DateSerial(YYYY, 2, 29)) = 2
End Function

Function NextDay(ByVal D As Date, ByVal DayCode As Long) As Date
' DayCode (1=Sun ... 7=Sat) or use vbSunday...vbSaturday.
  NextDay = D - Weekday(D) + DayCode + _
            IIf(Weekday(D) < DayCode, 0, 7)
End Function

Function NextDay1(ByVal D As Date, ByVal DayCode As Long) As Date
  NextDay1 = D - Weekday(D) + DayCode + _
             IIf(Weekday(D) <= DayCode, 0, 7)
End Function

Function PriorDay(ByVal D As Date, ByVal DayCode As Long) As Date
  PriorDay = D - Weekday(D) + DayCode - _
             IIf(Weekday(D) > DayCode, 0, 7)
End Function

Function PriorDay1(ByVal D As Date, ByVal DayCode As Long) As Date
  PriorDay1 = D - Weekday(D) + DayCode - _
              IIf(Weekday(D) >= DayCode, 0, 7)
End Function

Function StartOfMonth(ByVal D As Date) As Date
  StartOfMonth = DateSerial(Year(D), Month(D), 1)
End Function

Function StartOfWeek(ByVal D As Date) As Date
  StartOfWeek = D - Weekday(D) + 1
End Function