Tek-Tips is the largest IT community on the Internet today!
Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!
-
Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!
How can i calculate business days? 4
- Thread starter ruthcali
- Start date
JerryDennison
IS-IT--Management
You might try using the DateDiff() function. You can find the syntax under help.
-
3
- #3
MichaelRed
Programmer
Go here. Do this. Enjoy.
faq181-261 Calculate working days between two dates
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
faq181-261 Calculate working days between two dates
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
- Thread starter
- #4
Jerry, thanks for writing, but i need business days only. (becomes a little more complicated)
Wow Michael, thanks for the FAQ. did you write that code? pretty fancy!!
I'm not sure how to use it though.
i have a form (frmRptTotals) where the user enters a beginning date (txtDate1) and an ending date (txtDate2). then they click a button and a report opens. the report is based on a query.
in the query, i have many fields in this format:
OnTime: IIf(DateAdd("d",-43,[scheduled_date]) Between [Forms]![frmRptTotals]![txtDate1] And [Forms]![frmRptTotals]![txtDate2],1,0))
then in the Report Footer of my report, i have a text box: sum([OnTime])
The number 43 above has to be business days. Would i have to change my whole query in order to incorporate your function?
Thanks again for helping me! ruth.jonkman@wcom.com
Wow Michael, thanks for the FAQ. did you write that code? pretty fancy!!
I'm not sure how to use it though.
i have a form (frmRptTotals) where the user enters a beginning date (txtDate1) and an ending date (txtDate2). then they click a button and a report opens. the report is based on a query.
in the query, i have many fields in this format:
OnTime: IIf(DateAdd("d",-43,[scheduled_date]) Between [Forms]![frmRptTotals]![txtDate1] And [Forms]![frmRptTotals]![txtDate2],1,0))
then in the Report Footer of my report, i have a text box: sum([OnTime])
The number 43 above has to be business days. Would i have to change my whole query in order to incorporate your function?
Thanks again for helping me! ruth.jonkman@wcom.com
MichaelRed
Programmer
Actually, I was (again) moving to quickly and mis-read the post. The below code is better suited to what you asked for.
I did write the FAQ, as well as the variation below, which is actually a bit more involved - and a LOT less tested. So you should try quite a few "test cases" before committing to it's use. Also, please, if you find/fix any problem(s), post the changes here.
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
I did write the FAQ, as well as the variation below, which is actually a bit more involved - and a LOT less tested. So you should try quite a few "test cases" before committing to it's use. Also, please, if you find/fix any problem(s), post the changes here.
Code:
Public Function basWeekdays(StrtDt As Date, NumDays As Integer) As Date
'Usage:
'? basWeekdays(#1/10/01#, 23) Returns 2/16/01
'? basWeekdays(#1/10/01#, 260) Returns 1/31/02
'(But - Of Course - You need to Know the Holiday List)
'So "See" the Acompanying Table
Dim dbs As Database
Dim qdf As QueryDef
Dim rst As Recordset
Dim EndDt As Date 'Trial Date For end of Interval
Dim BeginDt As Date 'Start Date - Adjusted to NOT be Sat or Sun
Dim FinishDt As Date 'Real Ending Date
Dim DateDir As Integer 'Date Direction Flag
Dim MyDOW As Integer 'DayOfWeek Number for the Date
Dim DaysToAdd As Integer 'Number of Days to Adjust StrtDt to get to the
Dim Idx As Integer
Dim MyHoliDay As Date 'Date to Check For In Holiday Table
Dim strSQL As String
DateDir = Sgn(NumDays) 'Find out if we are going forward or Backward
Select Case Choose(WeekDay(StrtDt), 1, 2, 3, 4, 5, 6, 7)
Case Is = 7 Or 1 'Saturday Or Sunday
'Weekend, so Begin Day needs to be
If (DateDir = -1) Then 'Backwards
DaysToAdd = 6 - WeekDay(StrtDt)
BeginDt = DateAdd("d", DaysToAdd + DateDir, StrtDt)
Else
DaysToAdd = 2 - WeekDay(StrtDt)
BeginDt = DateAdd("d", DaysToAdd + 7 + DateDir, StrtDt)
End If
Case Else
'Weekday is a workday, So BeginDt is just the Start Day
BeginDt = StrtDt
End Select
EndDt = DateAdd("d", (7 / 5) * NumDays + DateDir, BeginDt) 'Trial End Date
MyDOW = Choose(WeekDay(EndDt), 1, 2, 3, 4, 5, 6, 7) 'Day of Week
Select Case MyDOW
Case Is = 1 'Sunday
'Again, Need to adjust the end date to NOT be a weekend day
If (DateDir > 0) Then 'Going Forward
DaysToAdd = 1
Else 'Backwards
DaysToAdd = -2
End If
Case Is = 7 'Saturday
'Again, Need to adjust the end date to NOT be a weekend day
If (DateDir > 0) Then 'Forwards
DaysToAdd = 2
Else
DaysToAdd = -1
End If
Case Else
'No adjustment necessary. End Date falls on a non-weekend day
DaysToAdd = 0
End Select
FinishDt = DateAdd("d", DaysToAdd, EndDt)
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qryNumHoliDayIncl")
strSQL = "SELECT Count(tblHolidays.HoliDate) AS NumHoliD "
strSQL = strSQL & "FROM tblHolidays "
strSQL = strSQL & "HAVING (((tblHolidays.HoliDate) Between "
strSQL = strSQL & Chr(35) & BeginDt & Chr(35) & " And "
strSQL = strSQL & Chr(35) & FinishDt & Chr(35) & " And "
strSQL = strSQL & "Weekday([Holidate])<>1 And Weekday([Holidate])<>1));"
qdf.SQL = strSQL
Set rst = dbs.OpenRecordset("qryNumHolidayIncl", dbOpenDynaset)
DaysToAdd = rst!NumHoliD
'Now, DaysToAdd represent the number of Holidays in the DateRange
'We need to adjust the End Date (AGAIN!!!) to Compensate!
'If, in this process, we encounter
'a "WeekEnd" Day OR an additional HOLLIDAY,
'Don't Count it
MyHoliDay = FinishDt
For Idx = 1 To DaysToAdd
'TestDate for Holiday/Weekend day
MyHoliDay = DateAdd("d", DateDir, MyHoliDay)
'Check For Sat., Sun., And MyHoliDay
strSQL = "SELECT Count(tblHolidays.HoliDate) AS NumHoliD "
strSQL = strSQL & "FROM tblHolidays "
strSQL = strSQL & "GROUP BY tblHolidays.HoliDate "
strSQL = strSQL & "HAVING (((tblHolidays.HoliDate) = "
strSQL = strSQL & Chr(35) & MyHoliDay & Chr(35) & "));"
qdf.SQL = strSQL
Set rst = dbs.OpenRecordset("qryNumHolidayIncl", dbOpenDynaset)
If (Not (rst.BOF) Or Not (rst.EOF)) Then
MyDOW = Choose(WeekDay(MyHoliDay), 1, 2, 3, 4, 5, 6, 7)
If (MyDOW <> 1 And MyDOW <> 7) Then
DaysToAdd = DaysToAdd + rst!NumHoliD
End If
End If
Next Idx
basWeekdays = DateAdd("d", DaysToAdd, FinishDt)
End Function
Code:
HoliDate Holiday
1/1/00 New Years Day
1/17/00 Martin Luther King Day
2/2/00 Groundhog Day
2/12/00 Lincon's Birthday
2/14/00 President's Day
2/21/00 Valentine's Day
2/22/00 Washington's Birthday
3/8/00 Ash Wednesday
3/17/00 St. Patrick's Day
4/1/00 April Fool's Day
4/20/00 Passover
4/21/00 Good Friday
5/5/00 Cinco de Mayo
5/5/00 Cinco de Mayo
5/14/00 Mother's Day
6/11/00 Pentecost
6/18/00 Father's Day
7/4/00 Independence Day
9/4/00 Labor Day
10/31/00 Halloween
11/11/00 tran's Day
11/23/00 Thanksgiving
12/25/00 Christmas
12/31/00 New Year's Eve
1/1/01 New Years Day
1/17/01 Martin Luther King Day
2/2/01 Groundhog Day
2/12/01 Lincon's Birthday
2/14/01 President's Day
2/21/01 Valentine's Day
2/22/01 Washington's Birthday
3/8/01 Ash Wednesday
3/17/01 St. Patrick's Day
4/1/01 April Fool's Day
4/20/01 Passover
4/21/01 Good Friday
5/14/01 Mother's Day
6/11/01 Pentecost
6/18/01 Father's Day
7/4/01 Independence Day
9/4/01 Labor Day
10/31/01 Halloween
11/11/01 tran's Day
11/23/01 Thanksgiving
12/25/01 Christmas
12/31/01 New Year's Eve
1/1/02 New Years Day
1/17/02 Martin Luther King Day
2/2/02 Groundhog Day
2/12/02 Lincon's Birthday
2/14/02 President's Day
2/21/02 Valentine's Day
2/22/02 Washington's Birthday
3/8/02 Ash Wednesday
3/17/02 St. Patrick's Day
4/1/02 April Fool's Day
4/20/02 Passover
4/21/02 Good Friday
5/5/02 Cinco de Mayo
5/14/02 Mother's Day
6/11/02 Pentecost
6/18/02 Father's Day
7/4/02 Independence Day
9/4/02 Labor Day
10/31/02 Halloween
11/11/02 tran's Day
11/23/02 Thanksgiving
12/25/02 Christmas
12/31/02 New Year's EveMichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
-
1
- #6
Not to get into a duel of the 10 page code routines. But, this is really good (and it was borrowed & adapted from a public site).
The code is put into a class module so that it can be called as one of two functions (AddWorkDays - to project a date x business days from a date & NetWorkDays - to count the elapsed business days).
The first section here is code that calls the AddWorkDays function after a date is entered. It should make sense with the comments and be readily adaptable to your context.
Private Sub txtVisitDate_AfterUpdate()
'Calls the AddWorkDays function in the clsModule
On Error GoTo Err_txtVisitDate
Dim objWorkDays As New clsWorkDays
Dim dtmVisitDate As Date, dtmDateDue As Date, dtmDueToSponsor As Date
Dim intDuetoLead As Integer, intDuetoSpnsr As Integer
If IsNull(txtDuetoLead) Or txtDuetoLead = "" _
Or IsNull(txtDuetoSpnsr) Or txtDuetoSponsor = "" Then
MsgBox "You must have values for the metrics", , "METRICS VALUES NEEDED"
GoTo Exit_txtVisitDate
End If
intDuetoLead = txtDuetoLead
intDuetoSpnsr = txtDuetoSpnsr
If IsNull(txtVisitDate) Or txtVisitDate = "" Then
MsgBox "You must enter a visit date"
GoTo Exit_txtVisitDate
End If
dtmVisitDate = CDate(txtVisitDate)
'Calls routine in class module
dtmDateDue = objWorkDays.AddWorkDays(dtmVisitDate, intDuetoLead)
txtReportDue = CStr(dtmDateDue)
dtmDueToSponsor = objWorkDays.AddWorkDays(dtmVisitDate, intDuetoSpnsr)
txtDuetoSponsor = CStr(dtmDueToSponsor)
Exit_txtVisitDate:
Set objWorkDays = Nothing
Exit Sub
Err_txtVisitDate:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_txtVisitDate
End Sub
'CLASS MODULE CODE
Option Compare Database
Option Explicit
Private mHolidayArray As Variant
Private Sub MakeHolidayArray()
ReDim mHolidayArray(13)
mHolidayArray(0) = #5/29/2000#
mHolidayArray(1) = #7/4/2000#
mHolidayArray(2) = #9/4/2000#
mHolidayArray(3) = #11/23/2000#
mHolidayArray(4) = #11/24/2000#
mHolidayArray(5) = #12/25/2000#
mHolidayArray(6) = #1/1/2001#
mHolidayArray(7) = #5/28/2001#
mHolidayArray(8) = #7/4/2001#
mHolidayArray(9) = #9/3/2000#
mHolidayArray(10) = #11/22/2001#
mHolidayArray(11) = #11/23/2001#
mHolidayArray(12) = #12/24/2001#
mHolidayArray(13) = #12/25/2001#
End Sub
Public Function AddWorkDays(StartDate As Date, DaysAdd As Integer) As Date
' Add the specified number of work days to the specified date.
'Requires: NextWorkDay(SkipDaysOff(IsWeekend, IsHoliday))
Dim dtmTemp As Date, intCount As Integer
'Check Holidays for viability
CheckHolidayArray
'Create Holiday list in mHolidayarray
MakeHolidayArray
dtmTemp = StartDate
For intCount = 1 To DaysAdd
dtmTemp = NextWorkDay(dtmTemp)
Next intCount
AddWorkDays = dtmTemp
End Function
Private Function NextWorkDay(dtmTemp As Date) As Date
'Return the next working day after the specified date.
'Calls: SkipDaysOff (which calls IsWeekend, IsHoliday)
'Calls: MakeHolidayArray defined above--fills module array variable mHolidayArray
NextWorkDay = SkipDaysOff(mHolidayArray, dtmTemp + 1, 1)
End Function
Private Function SkipDaysOff(ExcludeDates As Variant, dtmTemp As Date, intIncrement As Integer) As Date
'Skip weekend days, and holidays in the array
'set by the MakeHolidayArray function
'Return dtmTemp + as many days as it takes to get to next workday
' Requires: IsWeekend, IsHoliday
Dim strCriteria As String
Dim strFieldName As String
Dim intItem As Integer
Dim blnFound As Boolean
On Error GoTo HandleErrors
' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless ExcludeDates an item for every day in the year (!)
' this should finally converge on a weekday.
Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(ExcludeDates)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnFound = IsHoliday(dtmTemp, ExcludeDates)
If blnFound Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnFound
Case vbDate
If dtmTemp = ExcludeDates Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not IsWeekend(dtmTemp)
ExitHere:
SkipDaysOff = dtmTemp
Exit Function
HandleErrors:
Resume ExitHere
End Function
Private Function IsWeekend(dtmTemp As Variant) As Boolean
If VarType(dtmTemp) = vbDate Then
Select Case WeekDay(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End If
End Function
Private Function IsHoliday(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long
On Error GoTo HandleErrors
For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
IsHoliday = True
GoTo ExitHere
End If
Next lngItem
ExitHere:
Exit Function
HandleErrors:
' Do nothing at all.
' Return False.
Resume ExitHere
End Function
Public Function NetWorkDays(ByVal StartDate As Date, ByVal EndDate As Date) As Integer
'Count the business days in a given date range.
'Requires: SkipHolidays CountHolidays IsWeekend
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer
'Sub checks current date against Holiday List
CheckHolidayArray
'Make sure the module level array of Holiday dates is filled
MakeHolidayArray
intDays = EndDate - StartDate + 1
'Subtract weekend days between start and end dates
'(two for every complete week between.
intSubtract = (DateDiff("ww", StartDate, EndDate) * 2)
'Subtract any intervening holidays
intSubtract = intSubtract + CountHolidays(mHolidayArray, StartDate, EndDate)
NetWorkDays = intDays - intSubtract
End Function
Private Function CountHolidays(adtmDates As Variant, dtmStart As Date, dtmEnd As Date) As Long
'Count holidays between two end dates. Required by: dhCountWorkdays Requires: IsWeekend
Dim lngItem As Long
Dim lngCount As Long
Dim blnFound As Long
Dim dtmTemp As Date
On Error GoTo HandleErr
lngCount = 0
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
For lngItem = LBound(adtmDates) To UBound(adtmDates)
dtmTemp = adtmDates(lngItem)
If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
If Not IsWeekend(dtmTemp) Then
lngCount = lngCount + 1
End If
End If
Next lngItem
Case vbDate
' You got one date. So see if it's a non-weekend
' date between the two endpoints.
If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
If Not IsWeekend(adtmDates) Then
lngCount = 1
End If
End If
End Select
ExitHere:
CountHolidays = lngCount
Exit Function
HandleErr:
Resume ExitHere
End Function
Private Sub CheckHolidayArray()
If Date > #12/1/2001# Then
MsgBox "Holiday list is no longer current" & _
"--have Adminstrator update it", , "HOLIDAY LIST EXPIRED"
End If
End Sub
The code is put into a class module so that it can be called as one of two functions (AddWorkDays - to project a date x business days from a date & NetWorkDays - to count the elapsed business days).
The first section here is code that calls the AddWorkDays function after a date is entered. It should make sense with the comments and be readily adaptable to your context.
Private Sub txtVisitDate_AfterUpdate()
'Calls the AddWorkDays function in the clsModule
On Error GoTo Err_txtVisitDate
Dim objWorkDays As New clsWorkDays
Dim dtmVisitDate As Date, dtmDateDue As Date, dtmDueToSponsor As Date
Dim intDuetoLead As Integer, intDuetoSpnsr As Integer
If IsNull(txtDuetoLead) Or txtDuetoLead = "" _
Or IsNull(txtDuetoSpnsr) Or txtDuetoSponsor = "" Then
MsgBox "You must have values for the metrics", , "METRICS VALUES NEEDED"
GoTo Exit_txtVisitDate
End If
intDuetoLead = txtDuetoLead
intDuetoSpnsr = txtDuetoSpnsr
If IsNull(txtVisitDate) Or txtVisitDate = "" Then
MsgBox "You must enter a visit date"
GoTo Exit_txtVisitDate
End If
dtmVisitDate = CDate(txtVisitDate)
'Calls routine in class module
dtmDateDue = objWorkDays.AddWorkDays(dtmVisitDate, intDuetoLead)
txtReportDue = CStr(dtmDateDue)
dtmDueToSponsor = objWorkDays.AddWorkDays(dtmVisitDate, intDuetoSpnsr)
txtDuetoSponsor = CStr(dtmDueToSponsor)
Exit_txtVisitDate:
Set objWorkDays = Nothing
Exit Sub
Err_txtVisitDate:
MsgBox Err.Number & ": " & Err.Description
Resume Exit_txtVisitDate
End Sub
'CLASS MODULE CODE
Option Compare Database
Option Explicit
Private mHolidayArray As Variant
Private Sub MakeHolidayArray()
ReDim mHolidayArray(13)
mHolidayArray(0) = #5/29/2000#
mHolidayArray(1) = #7/4/2000#
mHolidayArray(2) = #9/4/2000#
mHolidayArray(3) = #11/23/2000#
mHolidayArray(4) = #11/24/2000#
mHolidayArray(5) = #12/25/2000#
mHolidayArray(6) = #1/1/2001#
mHolidayArray(7) = #5/28/2001#
mHolidayArray(8) = #7/4/2001#
mHolidayArray(9) = #9/3/2000#
mHolidayArray(10) = #11/22/2001#
mHolidayArray(11) = #11/23/2001#
mHolidayArray(12) = #12/24/2001#
mHolidayArray(13) = #12/25/2001#
End Sub
Public Function AddWorkDays(StartDate As Date, DaysAdd As Integer) As Date
' Add the specified number of work days to the specified date.
'Requires: NextWorkDay(SkipDaysOff(IsWeekend, IsHoliday))
Dim dtmTemp As Date, intCount As Integer
'Check Holidays for viability
CheckHolidayArray
'Create Holiday list in mHolidayarray
MakeHolidayArray
dtmTemp = StartDate
For intCount = 1 To DaysAdd
dtmTemp = NextWorkDay(dtmTemp)
Next intCount
AddWorkDays = dtmTemp
End Function
Private Function NextWorkDay(dtmTemp As Date) As Date
'Return the next working day after the specified date.
'Calls: SkipDaysOff (which calls IsWeekend, IsHoliday)
'Calls: MakeHolidayArray defined above--fills module array variable mHolidayArray
NextWorkDay = SkipDaysOff(mHolidayArray, dtmTemp + 1, 1)
End Function
Private Function SkipDaysOff(ExcludeDates As Variant, dtmTemp As Date, intIncrement As Integer) As Date
'Skip weekend days, and holidays in the array
'set by the MakeHolidayArray function
'Return dtmTemp + as many days as it takes to get to next workday
' Requires: IsWeekend, IsHoliday
Dim strCriteria As String
Dim strFieldName As String
Dim intItem As Integer
Dim blnFound As Boolean
On Error GoTo HandleErrors
' Move up to the first Monday/last Friday, if the first/last
' of the month was a weekend date. Then skip holidays.
' Repeat this entire process until you get to a weekday.
' Unless ExcludeDates an item for every day in the year (!)
' this should finally converge on a weekday.
Do
Do While IsWeekend(dtmTemp)
dtmTemp = dtmTemp + intIncrement
Loop
Select Case VarType(ExcludeDates)
Case vbArray + vbDate, vbArray + vbVariant
Do
blnFound = IsHoliday(dtmTemp, ExcludeDates)
If blnFound Then
dtmTemp = dtmTemp + intIncrement
End If
Loop Until Not blnFound
Case vbDate
If dtmTemp = ExcludeDates Then
dtmTemp = dtmTemp + intIncrement
End If
End Select
Loop Until Not IsWeekend(dtmTemp)
ExitHere:
SkipDaysOff = dtmTemp
Exit Function
HandleErrors:
Resume ExitHere
End Function
Private Function IsWeekend(dtmTemp As Variant) As Boolean
If VarType(dtmTemp) = vbDate Then
Select Case WeekDay(dtmTemp)
Case vbSaturday, vbSunday
IsWeekend = True
Case Else
IsWeekend = False
End Select
End If
End Function
Private Function IsHoliday(varItemToFind As Variant, _
avarItemsToSearch As Variant) As Boolean
Dim lngItem As Long
On Error GoTo HandleErrors
For lngItem = LBound(avarItemsToSearch) To UBound(avarItemsToSearch)
If avarItemsToSearch(lngItem) = varItemToFind Then
IsHoliday = True
GoTo ExitHere
End If
Next lngItem
ExitHere:
Exit Function
HandleErrors:
' Do nothing at all.
' Return False.
Resume ExitHere
End Function
Public Function NetWorkDays(ByVal StartDate As Date, ByVal EndDate As Date) As Integer
'Count the business days in a given date range.
'Requires: SkipHolidays CountHolidays IsWeekend
Dim intDays As Integer
Dim dtmTemp As Date
Dim intSubtract As Integer
'Sub checks current date against Holiday List
CheckHolidayArray
'Make sure the module level array of Holiday dates is filled
MakeHolidayArray
intDays = EndDate - StartDate + 1
'Subtract weekend days between start and end dates
'(two for every complete week between.
intSubtract = (DateDiff("ww", StartDate, EndDate) * 2)
'Subtract any intervening holidays
intSubtract = intSubtract + CountHolidays(mHolidayArray, StartDate, EndDate)
NetWorkDays = intDays - intSubtract
End Function
Private Function CountHolidays(adtmDates As Variant, dtmStart As Date, dtmEnd As Date) As Long
'Count holidays between two end dates. Required by: dhCountWorkdays Requires: IsWeekend
Dim lngItem As Long
Dim lngCount As Long
Dim blnFound As Long
Dim dtmTemp As Date
On Error GoTo HandleErr
lngCount = 0
Select Case VarType(adtmDates)
Case vbArray + vbDate, vbArray + vbVariant
For lngItem = LBound(adtmDates) To UBound(adtmDates)
dtmTemp = adtmDates(lngItem)
If dtmTemp >= dtmStart And dtmTemp <= dtmEnd Then
If Not IsWeekend(dtmTemp) Then
lngCount = lngCount + 1
End If
End If
Next lngItem
Case vbDate
' You got one date. So see if it's a non-weekend
' date between the two endpoints.
If adtmDates >= dtmStart And adtmDates <= dtmEnd Then
If Not IsWeekend(adtmDates) Then
lngCount = 1
End If
End If
End Select
ExitHere:
CountHolidays = lngCount
Exit Function
HandleErr:
Resume ExitHere
End Function
Private Sub CheckHolidayArray()
If Date > #12/1/2001# Then
MsgBox "Holiday list is no longer current" & _
"--have Adminstrator update it", , "HOLIDAY LIST EXPIRED"
End If
End Sub
MichaelRed
Programmer
Quehay,
Interesting. It does raise one issue which my function avoides/igmores. The Holiday list - where ever located needs to be checked to assure that it covers the range of dates to be traversed. Unfortunatly, the check - it 'your' case, the end date is "hard coded" and the start date is not checked. Better than what I did to some extent, since it DOES do something. Worse in the sence that it requires the source code to 'fix' the dates.
I'll take a look at fixing my version to at least check both ends dynamically. Since my process uses an ordinary table, the actual entering/definition of holidays is easily maintained w/o the need for the source code.
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
Interesting. It does raise one issue which my function avoides/igmores. The Holiday list - where ever located needs to be checked to assure that it covers the range of dates to be traversed. Unfortunatly, the check - it 'your' case, the end date is "hard coded" and the start date is not checked. Better than what I did to some extent, since it DOES do something. Worse in the sence that it requires the source code to 'fix' the dates.
I'll take a look at fixing my version to at least check both ends dynamically. Since my process uses an ordinary table, the actual entering/definition of holidays is easily maintained w/o the need for the source code.
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
- Thread starter
- #8
Wow!!!!!!!!!!!!!!!!!
This is overwhelming. thank you both so much. that is very impressive code! thank you so much for your help!!!! You are both my guardian angels.
i'm just not sure how to use it in my query, though.
i have a form (frmRptTotals) where the user enters a beginning date (txtDate1) and an ending date (txtDate2). then they click a button and a report opens. the report is based on a query.
in the query, i have many fields in this format:
OnTime: IIf(DateAdd("d",-43,[scheduled_date]) Between [Forms]![frmRptTotals]![txtDate1] And [Forms]![frmRptTotals]![txtDate2],1,0))
then in the Report Footer of my report, i have a text box: sum([OnTime])
The number 43 above has to be business days. Would i have to change my whole query in order to incorporate your function?
can i call a function from inside a calculated control in a query?
ruth.jonkman@wcom.com
This is overwhelming. thank you both so much. that is very impressive code! thank you so much for your help!!!! You are both my guardian angels.
i'm just not sure how to use it in my query, though.
i have a form (frmRptTotals) where the user enters a beginning date (txtDate1) and an ending date (txtDate2). then they click a button and a report opens. the report is based on a query.
in the query, i have many fields in this format:
OnTime: IIf(DateAdd("d",-43,[scheduled_date]) Between [Forms]![frmRptTotals]![txtDate1] And [Forms]![frmRptTotals]![txtDate2],1,0))
then in the Report Footer of my report, i have a text box: sum([OnTime])
The number 43 above has to be business days. Would i have to change my whole query in order to incorporate your function?
can i call a function from inside a calculated control in a query?
ruth.jonkman@wcom.com
MichaelRed
Programmer
OnTime: IIF(basWeekdays([scheduled_date] -43) Between [Forms]![frmRptTotals]![txtDate1] And [Forms]![frmRptTotals]![txtDate2],1,0))
[red]BUT !!!![/red]
Rember also to create and PROPERLY populate the table Holidays. In the table, be sure you ues the date of observance for the holiday (if the holiday occurs on a week end but your office 'observes' it on the following Monday, put Monday's - NOT the actual date).
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
[red]BUT !!!![/red]
Rember also to create and PROPERLY populate the table Holidays. In the table, be sure you ues the date of observance for the holiday (if the holiday occurs on a week end but your office 'observes' it on the following Monday, put Monday's - NOT the actual date).
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
- Thread starter
- #10
Wow! you can do that? that is great!!
i can't wait to try it out.
we only have 7 official holidays so i am not too worried about couting holidays.
i guess that will lessen the code a bit.
but thank you thank you thank you. my boss will be very happy.
ruth.jonkman@wcom.com
i can't wait to try it out.
we only have 7 official holidays so i am not too worried about couting holidays.
i guess that will lessen the code a bit.
but thank you thank you thank you. my boss will be very happy.
ruth.jonkman@wcom.com
MichaelRed
Programmer
It is easier to include the holidays than omit htem from this process. To Include them, all you need to do is create the table and fill in the dates. To omit them, you have to go through the code and figure out where the table is referenced and remove the reference. Also, leaving the holidays out could end up with as much as three days error in the calculation. NOT " ... my boss will be very happy ... "
Further, if you can do it once, you can be sure (if it's Westinghouse?) that you will be "asked" to do it again, with other requirements and variations. Removing functionallity usually means putting it back in again at a later date!
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
Further, if you can do it once, you can be sure (if it's Westinghouse?) that you will be "asked" to do it again, with other requirements and variations. Removing functionallity usually means putting it back in again at a later date!
MichaelRed
mred@duvallgroup.com
There is never time to do it right but there is always time to do it over
i seek enlightenment ;-) & i'm *not* being critical..
while lurking on this thread i was trying to work things out on my own. i came up with the following routines.
one counts work days & the other gets you the nth work day forward. i'm using a table to store holidays.
there is *no error checking* & for now they're only working in the forward direction but my pilot tests are working just fine.
they're a bit shorter (notationally) & they seem more straightforward then what you've posted. but there may be very good reasons for why your routines took their shape so...
my question is, is there a problem with these routines or their general approach that you can see?
Public Function WorkDayCount(FromDate As Date, ToDate As Date) As Integer
Dim HolidayRS As New ADODB.RecordSet
WorkDayCount = DateDiff("d", FromDate, ToDate) + 1
WorkDayCount = WorkDayCount - DateDiff("ww", FromDate, ToDate, vbSaturday)
If DatePart("w", FromDate) = 7 Then WorkDayCount = WorkDayCount - 1
WorkDayCount = WorkDayCount - DateDiff("ww", FromDate, ToDate, vbSunday)
If DatePart("w", FromDate) = 1 Then WorkDayCount = WorkDayCount - 1
HolidayRS.Open "SELECT Date From HolidayList " _
& " WHERE (Date)>=#" & FromDate & "# And Date<=#" & ToDate & "#;" _
, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
WorkDayCount = WorkDayCount - HolidayRS.RecordCount
HolidayRS.Close
End Function
Public Function WorkDayFind(StartDate As Date, DaysForward As Integer) As Date
Dim WorkDays As Integer
WorkDays = 0
WorkDayFind = StartDate
Do
WorkDayFind = DateAdd("d", DaysForward - WorkDays, WorkDayFind)
WorkDays = WorkDayCount(StartDate, WorkDayFind)
Loop Until WorkDays = DaysForward
End Function
thanks
while lurking on this thread i was trying to work things out on my own. i came up with the following routines.
one counts work days & the other gets you the nth work day forward. i'm using a table to store holidays.
there is *no error checking* & for now they're only working in the forward direction but my pilot tests are working just fine.
they're a bit shorter (notationally) & they seem more straightforward then what you've posted. but there may be very good reasons for why your routines took their shape so...
my question is, is there a problem with these routines or their general approach that you can see?
Public Function WorkDayCount(FromDate As Date, ToDate As Date) As Integer
Dim HolidayRS As New ADODB.RecordSet
WorkDayCount = DateDiff("d", FromDate, ToDate) + 1
WorkDayCount = WorkDayCount - DateDiff("ww", FromDate, ToDate, vbSaturday)
If DatePart("w", FromDate) = 7 Then WorkDayCount = WorkDayCount - 1
WorkDayCount = WorkDayCount - DateDiff("ww", FromDate, ToDate, vbSunday)
If DatePart("w", FromDate) = 1 Then WorkDayCount = WorkDayCount - 1
HolidayRS.Open "SELECT Date From HolidayList " _
& " WHERE (Date)>=#" & FromDate & "# And Date<=#" & ToDate & "#;" _
, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
WorkDayCount = WorkDayCount - HolidayRS.RecordCount
HolidayRS.Close
End Function
Public Function WorkDayFind(StartDate As Date, DaysForward As Integer) As Date
Dim WorkDays As Integer
WorkDays = 0
WorkDayFind = StartDate
Do
WorkDayFind = DateAdd("d", DaysForward - WorkDays, WorkDayFind)
WorkDays = WorkDayCount(StartDate, WorkDayFind)
Loop Until WorkDays = DaysForward
End Function
thanks
- Status
Similar threads
- Locked
- Question
- Locked
- Question
- Locked
- Question
- Locked
- Question