Navigation
Install the app
How to install the app on iOS
Follow along with the video below to see how to install our site as a web app on your home screen.
Note: This feature may not be available in some browsers.
More options
-
Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
Various Day Calculation Functions
How To
Various Day Calculation Functions
by
SgtJarrow
Posted
(Edited
)
Much of this code was design loosley based on MichaelRed's faq705-3213. He deserves at least a little credit. Just paste the whole thing into new module and read the comments for how to use.
' ################ Begin Code ######################
Public Function IsWeekend(dtmDate As Date) As Boolean
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine if the date provided is a weekend
'In: dteDate is the date to be checked
'Out: Returns either True if the date is a Saturday or Sunday and False if any other
' day of the week
'Example: IsWeekend(#2/19/03#) returns False
'****************************************
Select Case WeekDay(dtmDate)
Case vbSaturday, vbSunday: IsWeekend = True
Case Else: IsWeekend = False
End Select
End Function
Public Function IsHoliday(dtmDate As Date) As Boolean
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine if the date provided is a Holiday
' NOTE: This function requires a table called tblHolidays with one field called
' HolDate which is a date/time field and includes all the dates you consider
' holidays
'In: dteDate is the date to be checked
'Out: Returns either True if the date is found in the table (a holiday) and False
' if the date is not found in the table
'Example: IsHoliday(#1/1/03#) returns True (New Year's Day)
'****************************************
Dim db As Database
Dim rs As Recordset
Dim strCriteria As String
Set db = CurrentDb
Set rs = db.OpenRecordset("tblHolidays", dbOpenSnapshot)
strCriteria = "[HolDate] = #" & dtmDate & "#"
rs.FindFirst strCriteria
If rs.NoMatch Then
IsHoliday = False
Else
IsHoliday = True
End If
Set rs = Nothing
Set db = Nothing
End Function
Public Function FirstDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the first calendar day of month
'In: dteDate is the date to be checked
'Out: Returns the first calendar day of month
'Example: FirstDayOfMonth(#1/4/03#) returns 1/1/03
'****************************************
FirstDayOfMonth = DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function
Public Function LastDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the last calendar day of month
'In: dteDate is the date to be checked
'Out: Returns the last calendar day of month
'Example: LastDayOfMonth(#1/4/03#) returns 1/31/03
'****************************************
LastDayOfMonth = DateAdd("d", -1, DateSerial(Year(dtmDate), Month(dtmDate) + 1, 1))
End Function
Public Function FirstWorkDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the first business (working) day of the month
'In: dteDate is the date to be checked
'Out: Returns the first business day of the month
'Example: FirstWorkDayOfMonth(#1/4/03#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnFirstWorkday As Boolean
dtmTemp = FirstDayOfMonth(dtmDate)
blnFirstWorkday = False
Do Until blnFirstWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", 1, dtmTemp)
Else
blnFirstWorkday = True
End If
Loop
FirstWorkDayOfMonth = dtmTemp
End Function
Public Function LastWorkDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the last business (working) day of the month
'In: dteDate is the date to be checked
'Out: Returns the last business day of the month
'Example: LastWorkDayOfMonth(#1/4/03#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnLastWorkday As Boolean
dtmTemp = LastDayOfMonth(dtmDate)
blnLastWorkday = False
Do Until blnLastWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", -1, dtmTemp)
Else
blnLastWorkday = True
End If
Loop
LastWorkDayOfMonth = dtmTemp
End Function
Public Function DaysInMonth(dtmDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of calendar days in month
'In: dteDate is the date to be checked
'Out: Returns number of calendar day in month
'Example: DaysInMonth(#1/4/03#) returns 31
'****************************************
Dim dtmTemp As Date
dtmTemp = LastDayOfMonth(dtmDate)
DaysInMonth = CInt(Format(dtmTemp, "dd"))
End Function
Public Function NextWorkDay(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the next business (working) day
'In: dteDate is the date to be checked
'Out: Returns the next business day
'Example: NextWorkDay(#12/31/02#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnNextWorkday As Boolean
dtmTemp = dtmDate + 1
blnNextWorkday = False
Do Until blnNextWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", 1, dtmTemp)
Else
blnNextWorkday = True
End If
Loop
NextWorkDay = dtmTemp
End Function
Public Function PreviousWorkDay(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the previous business (working) day
'In: dteDate is the date to be checked
'Out: Returns the previous business day
'Example: PreviousWorkDay(#1/2/03#) returns 12/31/02
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnPreviousWorkday As Boolean
dtmTemp = dtmDate - 1
blnPreviousWorkday = False
Do Until blnPreviousWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", -1, dtmTemp)
Else
blnPreviousWorkday = True
End If
Loop
PreviousWorkDay = dtmTemp
End Function
Public Function CountHolidays(dtmStartDate As Date, dtmEndDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of holidays between two dates
'In: dteStartDate is the first date, dtmEndDate is the last date
'Out: Returns the number of holidays between start and end date
'Example: CountHolidays(#12/31/02#, #1/3/03#) returns 1
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim intHolidayCount As Integer
Dim intDaysBetweenDates As Integer
Dim i As Integer
Dim dtmTemp As Date
If dtmStartDate > dtmEndDate Then
dtmTemp = dtmStartDate
dtmStartDate = dtmEndDate
dtmEndDate = dtmTemp
End If
intHolidayCount = 0
intDaysBetweenDates = dtmEndDate - dtmStartDate
For i = 0 To intDaysBetweenDates
If IsHoliday(DateAdd("d", i, dtmStartDate)) = True Then intHolidayCount = intHolidayCount + 1
Next i
CountHolidays = intHolidayCount
End Function
Public Function CountWorkDays(dtmStartDate As Date, dtmEndDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of business days between two dates
'In: dteStartDate is the first date, dtmEndDate is the last date
'Out: Returns the number of business between start and end date
'Example: CountWorkDays(#12/31/02#, #1/3/03#) returns 3
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim intWorkDayCount As Integer
Dim intDaysBetweenDates As Integer
Dim i As Integer
Dim dtmTemp As Date
If dtmStartDate > dtmEndDate Then
dtmTemp = dtmStartDate
dtmStartDate = dtmEndDate
dtmEndDate = dtmTemp
End If
intWorkDayCount = 0
intDaysBetweenDates = dtmEndDate - dtmStartDate
For i = 0 To intDaysBetweenDates
If IsHoliday(DateAdd("d", i, dtmStartDate)) = False And _
IsWeekend(DateAdd("d", i, dtmStartDate)) = False Then intWorkDayCount = intWorkDayCount + 1
Next i
CountWorkDays = intWorkDayCount
End Function
Public Function AddWorkDays(dtmDate As Date, intDays As Integer) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Adds a number of business days to a starting date
'In: dteDate is the date, intDays is the number of days to add
'Out: Returns the date the number of business days after the start date
'Example: AddWorkDays(#12/31/02#, 4) returns 1/6/03
' (1/1/01 is a holiday (New Year's Day), 1/4/03 and 1/5/03 are weekend days)
'****************************************
Dim dtmTemp As Date
Dim i As Integer
dtmTemp = dtmDate
For i = 1 To intDays
dtmTemp = NextWorkDay(dtmTemp)
Next i
AddWorkDays = dtmTemp
End Function
' ################ End Code ########################
' ################ Begin Code ######################
Public Function IsWeekend(dtmDate As Date) As Boolean
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine if the date provided is a weekend
'In: dteDate is the date to be checked
'Out: Returns either True if the date is a Saturday or Sunday and False if any other
' day of the week
'Example: IsWeekend(#2/19/03#) returns False
'****************************************
Select Case WeekDay(dtmDate)
Case vbSaturday, vbSunday: IsWeekend = True
Case Else: IsWeekend = False
End Select
End Function
Public Function IsHoliday(dtmDate As Date) As Boolean
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine if the date provided is a Holiday
' NOTE: This function requires a table called tblHolidays with one field called
' HolDate which is a date/time field and includes all the dates you consider
' holidays
'In: dteDate is the date to be checked
'Out: Returns either True if the date is found in the table (a holiday) and False
' if the date is not found in the table
'Example: IsHoliday(#1/1/03#) returns True (New Year's Day)
'****************************************
Dim db As Database
Dim rs As Recordset
Dim strCriteria As String
Set db = CurrentDb
Set rs = db.OpenRecordset("tblHolidays", dbOpenSnapshot)
strCriteria = "[HolDate] = #" & dtmDate & "#"
rs.FindFirst strCriteria
If rs.NoMatch Then
IsHoliday = False
Else
IsHoliday = True
End If
Set rs = Nothing
Set db = Nothing
End Function
Public Function FirstDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the first calendar day of month
'In: dteDate is the date to be checked
'Out: Returns the first calendar day of month
'Example: FirstDayOfMonth(#1/4/03#) returns 1/1/03
'****************************************
FirstDayOfMonth = DateSerial(Year(dtmDate), Month(dtmDate), 1)
End Function
Public Function LastDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the last calendar day of month
'In: dteDate is the date to be checked
'Out: Returns the last calendar day of month
'Example: LastDayOfMonth(#1/4/03#) returns 1/31/03
'****************************************
LastDayOfMonth = DateAdd("d", -1, DateSerial(Year(dtmDate), Month(dtmDate) + 1, 1))
End Function
Public Function FirstWorkDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the first business (working) day of the month
'In: dteDate is the date to be checked
'Out: Returns the first business day of the month
'Example: FirstWorkDayOfMonth(#1/4/03#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnFirstWorkday As Boolean
dtmTemp = FirstDayOfMonth(dtmDate)
blnFirstWorkday = False
Do Until blnFirstWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", 1, dtmTemp)
Else
blnFirstWorkday = True
End If
Loop
FirstWorkDayOfMonth = dtmTemp
End Function
Public Function LastWorkDayOfMonth(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the last business (working) day of the month
'In: dteDate is the date to be checked
'Out: Returns the last business day of the month
'Example: LastWorkDayOfMonth(#1/4/03#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnLastWorkday As Boolean
dtmTemp = LastDayOfMonth(dtmDate)
blnLastWorkday = False
Do Until blnLastWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", -1, dtmTemp)
Else
blnLastWorkday = True
End If
Loop
LastWorkDayOfMonth = dtmTemp
End Function
Public Function DaysInMonth(dtmDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of calendar days in month
'In: dteDate is the date to be checked
'Out: Returns number of calendar day in month
'Example: DaysInMonth(#1/4/03#) returns 31
'****************************************
Dim dtmTemp As Date
dtmTemp = LastDayOfMonth(dtmDate)
DaysInMonth = CInt(Format(dtmTemp, "dd"))
End Function
Public Function NextWorkDay(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the next business (working) day
'In: dteDate is the date to be checked
'Out: Returns the next business day
'Example: NextWorkDay(#12/31/02#) returns 1/2/03
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnNextWorkday As Boolean
dtmTemp = dtmDate + 1
blnNextWorkday = False
Do Until blnNextWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", 1, dtmTemp)
Else
blnNextWorkday = True
End If
Loop
NextWorkDay = dtmTemp
End Function
Public Function PreviousWorkDay(dtmDate As Date) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the previous business (working) day
'In: dteDate is the date to be checked
'Out: Returns the previous business day
'Example: PreviousWorkDay(#1/2/03#) returns 12/31/02
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim dtmTemp As Date
Dim blnPreviousWorkday As Boolean
dtmTemp = dtmDate - 1
blnPreviousWorkday = False
Do Until blnPreviousWorkday = True
If IsWeekend(dtmTemp) = True Or IsHoliday(dtmTemp) = True Then
dtmTemp = DateAdd("d", -1, dtmTemp)
Else
blnPreviousWorkday = True
End If
Loop
PreviousWorkDay = dtmTemp
End Function
Public Function CountHolidays(dtmStartDate As Date, dtmEndDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of holidays between two dates
'In: dteStartDate is the first date, dtmEndDate is the last date
'Out: Returns the number of holidays between start and end date
'Example: CountHolidays(#12/31/02#, #1/3/03#) returns 1
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim intHolidayCount As Integer
Dim intDaysBetweenDates As Integer
Dim i As Integer
Dim dtmTemp As Date
If dtmStartDate > dtmEndDate Then
dtmTemp = dtmStartDate
dtmStartDate = dtmEndDate
dtmEndDate = dtmTemp
End If
intHolidayCount = 0
intDaysBetweenDates = dtmEndDate - dtmStartDate
For i = 0 To intDaysBetweenDates
If IsHoliday(DateAdd("d", i, dtmStartDate)) = True Then intHolidayCount = intHolidayCount + 1
Next i
CountHolidays = intHolidayCount
End Function
Public Function CountWorkDays(dtmStartDate As Date, dtmEndDate As Date) As Integer
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Determine the number of business days between two dates
'In: dteStartDate is the first date, dtmEndDate is the last date
'Out: Returns the number of business between start and end date
'Example: CountWorkDays(#12/31/02#, #1/3/03#) returns 3
' (1/1/01 is a holiday (New Year's Day))
'****************************************
Dim intWorkDayCount As Integer
Dim intDaysBetweenDates As Integer
Dim i As Integer
Dim dtmTemp As Date
If dtmStartDate > dtmEndDate Then
dtmTemp = dtmStartDate
dtmStartDate = dtmEndDate
dtmEndDate = dtmTemp
End If
intWorkDayCount = 0
intDaysBetweenDates = dtmEndDate - dtmStartDate
For i = 0 To intDaysBetweenDates
If IsHoliday(DateAdd("d", i, dtmStartDate)) = False And _
IsWeekend(DateAdd("d", i, dtmStartDate)) = False Then intWorkDayCount = intWorkDayCount + 1
Next i
CountWorkDays = intWorkDayCount
End Function
Public Function AddWorkDays(dtmDate As Date, intDays As Integer) As Date
'****************************************
'Created By: Robert L. Johnson III
'Mod Date: February 19, 2003
'Purpose: Adds a number of business days to a starting date
'In: dteDate is the date, intDays is the number of days to add
'Out: Returns the date the number of business days after the start date
'Example: AddWorkDays(#12/31/02#, 4) returns 1/6/03
' (1/1/01 is a holiday (New Year's Day), 1/4/03 and 1/5/03 are weekend days)
'****************************************
Dim dtmTemp As Date
Dim i As Integer
dtmTemp = dtmDate
For i = 1 To intDays
dtmTemp = NextWorkDay(dtmTemp)
Next i
AddWorkDays = dtmTemp
End Function
' ################ End Code ########################
Please Note: 1 is Bad, 10 is Good :-)
Part and Inventory Search
-
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.