ID: Q185480
The information in this article applies to:
This article shows how to include several useful date calculation routines in your application.
Microsoft provides programming examples for illustration only, without warranty either expressed or implied, including, but not limited to, the implied warranties of merchantability and/or fitness for a particular purpose. This article assumes that you are familiar with the programming language being demonstrated and the tools used to create and debug procedures.
The procedures included are:
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.
1. Create a new project and add a module to the project.
2. Add the following code to the module:
Sample Code
-----------
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
4. You can test the functions by typing each of the following expressions
in the Immediate window:
?LeapYear(1998)
?NextDay(Date(), vbSaturday)
?EndOfMonth(Date())
?Age(#12/1/1966#, Date())
or use the following code as a sample of how to call one of the date
calculation functions from your code:
Dim bLeapYear As Boolean, D As Date, iAge As Long
bLeapYear = LeapYear(Year(Date()))
D = EndOfMonth(Date())
iAge = Age(#12/1/1966#, Date())
For additional information, please see the following article(s) in the Microsoft Knowledge Base:
ARTICLE-ID: Q88657
TITLE : ACC: Functions for Calculating and Displaying Date/Time
Values
ARTICLE-ID: Q100136
TITLE : ACC: Two Functions to Calculate Age in Months and Years
Additional query words: vba kbVBA kbVBp kbDSupport kbDSD Issue type : kbhowto
Last Reviewed: May 13, 1998