Microsoft KB Archive/185480

= How To Write Date Calculation Routines =

Article ID: 185480

Article Last Modified on 7/14/2004

-

APPLIES TO


 * Microsoft Visual Basic for Applications 5.0

-



This article was previously published under Q185480



SUMMARY
This article shows how to include several useful date calculation routines in your application.



MORE INFORMATION
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.

Step-by-Step Example
 Create a new project and add a module to the project.  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  Run the project, and then press CTRL+BREAK to pause it.  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) 

