Help with Code and Working Days including Holidays

[Kevin]

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate] and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

 

[Douglas J. Steele]

Rather than bothering with the recordset, just calculate the date difference
ignoring Saturday and Sunday, and then subtract DCount("*", "tblHolidays",
"[HoliDate] BETWEEN " & Format([StartDate], "\#yyyy\-mm\-dd\#") & " AND " &
Format([EndDate], "\#yyyy\-mm\-dd\#") & " AND Weekday([HoliDate]) NOT IN (1,
7)")

 

[Kevin]

Hi Douglas,

Thanks for the advice, but how does this fit into the code? (I am learning
as I go!)

Thanks again

KKevin

Rather than bothering with the recordset, just calculate the date difference
ignoring Saturday and Sunday, and then subtract DCount("*", "tblHolidays",
"[HoliDate] BETWEEN " & Format([StartDate], "\#yyyy\-mm\-dd\#") & " AND " &
Format([EndDate], "\#yyyy\-mm\-dd\#") & " AND Weekday([HoliDate]) NOT IN (1,
7)")

--
Doug Steele, Microsoft Access MVP

(no e-mails, please!)

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate]
and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

 

[Dirk Goldgar]

Answered elsewhere.

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate]
and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

 

[Kevin]

Thanks Dirk,

'Answered Eleswhere' really helps me.

I might be a bit of a novice, and although I use the forum a lot to help
answer any problems I have, I only post questions as a last resort.

I have spent best part of 8 hours today trying to figure this one out before
posting my question, so if you are not going to offer some useful advice why
bother resonding!

But thanks to all the others out there who do help us novices, it is much
appreciated!

Answered elsewhere.

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate]
and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

 

[Rob Parker]

That's rather ungrateful. Dirk is an MVP who offers excellent advice. The
"answered elsewhere" is his way of telling you that your question has been
answered in another group, where you have posted the same question. You
brought this upon yourself by multi-posting. Posting the same question to
multiple Access groups is rarely necessary, and if for some reason you must
do so, then do it by cross-posting (ie. listing several groups in the
newsgroup address field) rather than multi-posting; that way, an answer in
one group gets shown in all groups where the question was posted.

Rob

Thanks Dirk,

'Answered Eleswhere' really helps me.

I might be a bit of a novice, and although I use the forum a lot to
help answer any problems I have, I only post questions as a last
resort.

I have spent best part of 8 hours today trying to figure this one out
before posting my question, so if you are not going to offer some
useful advice why bother resonding!

But thanks to all the others out there who do help us novices, it is
much appreciated!

Answered elsewhere.

Hi,

I have found this code to work out date difference (working days
only) and to include holidays from my [tblHolidays] table the code
seems to work if only one date in my holiday table falls between
the [StartDate] and [Enddate], but if there is more than one
holiday date between [StartDate] and
[EndDate] it only seems to take off the first. (I hope this makes
sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As
Date) As Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to
allow 'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate &
NumSgn rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will
return a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

 

[Dirk Goldgar]

Thanks Dirk,

'Answered Eleswhere' really helps me.

I might be a bit of a novice, and although I use the forum a lot to help
answer any problems I have, I only post questions as a last resort.

I have spent best part of 8 hours today trying to figure this one out
before
posting my question, so if you are not going to offer some useful advice
why
bother resonding!

You posted this same question in another newsgroup and I answered it there.
You could save time by asking your question in only one newsgroup, or else
cross-posting it rather than multiposting it. Otherwise, you'll waste time
chasing multiple response threads, and others will waste time answering
questions that have already been answered.

 

[Ken Sheridan]

Might I suggest an alternative approach. First create a Calendar table.
This is simply a table of all dates over a period (10 years say) and is
easily created by serially filling down a column with consecutive dates in
Excel and then importing the worksheet into Access as a table. Call the
table's single column CalDate. You'll find that an auxiliary calendar table
like this has many other uses BTW.

Then create table which LEFT JOINs the Calendar table to your tblHolidays
table and returns rows where the data is not a Saturday or Sunday, and where
there is no matching row in tblHolidays:

SELECT CalDate
FROM Calendar LEFT JOIN Holidays
ON Calendar.CalDate = Holidays.HoliDate
WHERE Holidays.HoliDate IS NULL
AND WEEKDAY(CalDate,2) < 6;

You could create this query in design view as follows but its easier to open
the query designer, don't add any tables, switch to SQL view, and paste the
above SQL in. To see how it would be done in design view you can switch to
design view, but I'd suggest you save it in SQL view. If you open the query
it should return all dates apart from weekends and any in your Holidays table.

You can now create a much simpler function which counts the rows between two
dates using the DCount function:

Public Function WorkdaysBetween(dtmStart As Date, dtmEnd As Date) As Integer

Dim strCriteria As String
Dim strStart As String, strEnd As String

' format dates in an internationally unambiguous format
strStart = "#" & Format(dtmStart, "yyyy-mm-dd") & "#"
strEnd = "#" & Format(dtmEnd, "yyyy-mm-dd") & "#"

strCriteria = "CalDate Between " & strStart & " And " & strEnd

' count days between the dates
WorkdaysBetween = DCount("*", "qryWorkDays", strCriteria)

End Function

Ken Sheridan
Stafford, England

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate] and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

 

[Dirk Goldgar]

Might I suggest an alternative approach. First create a Calendar table.
This is simply a table of all dates over a period (10 years say) and is
easily created by serially filling down a column with consecutive dates in
Excel and then importing the worksheet into Access as a table. Call the
table's single column CalDate. You'll find that an auxiliary calendar
table
like this has many other uses BTW.

Then create table which LEFT JOINs the Calendar table to your tblHolidays
table and returns rows where the data is not a Saturday or Sunday, and
where
there is no matching row in tblHolidays:

SELECT CalDate
FROM Calendar LEFT JOIN Holidays
ON Calendar.CalDate = Holidays.HoliDate
WHERE Holidays.HoliDate IS NULL
AND WEEKDAY(CalDate,2) < 6;

If I were going to take this approach, I'd have a Weekday field as well as
the CalDate field, and pre-calculate the Weekday for each date when I load
the table. That would make the query even more efficient, as it would not
need to call the VBA function.

 

[Kevin]

Dirk / Rob,

I did post this question in another thread (mistakingley), but as it was not
appropriate for that newsgroup I deleted it, Dirk must have answered before I
had the chance.

Please accept my apologies, after hours of hunting to find my answer I am
very frustrated, and I, obviously, mistakingly took Dirks answer as a
flippant comment.

I (and I'm sure many others), really appreciate the help and assistance
offered by members of the forum, and I certainly do not wish to disrespect
anyone who offers assistance to other learners like myself.

Please accept my sincere apology!

 

[Kevin]

Hi Ken,

Thank you very much for your comprehensive response, I am trying your
solution now, although I think it may have to wait unil tomorrow because I am
starting to bang my head off the wall now.

I will post a response after testing.

Thanks again
Kevin

Might I suggest an alternative approach. First create a Calendar table.
This is simply a table of all dates over a period (10 years say) and is
easily created by serially filling down a column with consecutive dates in
Excel and then importing the worksheet into Access as a table. Call the
table's single column CalDate. You'll find that an auxiliary calendar table
like this has many other uses BTW.

Then create table which LEFT JOINs the Calendar table to your tblHolidays
table and returns rows where the data is not a Saturday or Sunday, and where
there is no matching row in tblHolidays:

SELECT CalDate
FROM Calendar LEFT JOIN Holidays
ON Calendar.CalDate = Holidays.HoliDate
WHERE Holidays.HoliDate IS NULL
AND WEEKDAY(CalDate,2) < 6;

You could create this query in design view as follows but its easier to open
the query designer, don't add any tables, switch to SQL view, and paste the
above SQL in. To see how it would be done in design view you can switch to
design view, but I'd suggest you save it in SQL view. If you open the query
it should return all dates apart from weekends and any in your Holidays table.

You can now create a much simpler function which counts the rows between two
dates using the DCount function:

Public Function WorkdaysBetween(dtmStart As Date, dtmEnd As Date) As Integer

Dim strCriteria As String
Dim strStart As String, strEnd As String

' format dates in an internationally unambiguous format
strStart = "#" & Format(dtmStart, "yyyy-mm-dd") & "#"
strEnd = "#" & Format(dtmEnd, "yyyy-mm-dd") & "#"

strCriteria = "CalDate Between " & strStart & " And " & strEnd

' count days between the dates
WorkdaysBetween = DCount("*", "qryWorkDays", strCriteria)

End Function

Ken Sheridan
Stafford, England

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate] and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function

 

[Dirk Goldgar]

[...]
Please accept my sincere apology!

Fair enough; accepted. But if you didn't see my response in that other
thread, here's what it said:

<quote>
That is a *terribly* written function, but so far as I can tell it should
still work. I tested it, and didn't see the behavior you describe. It gave
the correct count, even when there were more than one holiday in the span of
dates.

</quote>

So while there are better ways to write that function -- and also Ken's
alternative approach of creating a table of pre-calculated dates, which has
its advantages and disadvantages -- that function as you originally posted
it should at least give you the right answer. I'd be interested to know
what you observed that made you think that it didn't. The basic algorithm
is sound. The only thing I can think of that could make it appear to give
an incorrect answer is something incorrect in the Holidays table, since we
can't see its design and don't know what records it contains.

 

[Arvin Meyer [MVP]]

That is poorly written and is bound to give you problems. Here is one that
adds or subtracts a number of working days, and allows for holidays,
including holidays that fall on weekends:

http://www.datastrat.com/Code/GetBusinessDay.txt

Here's a couple more that count the number of working days:

http://www.mvps.org/access/datetime/date0006.htm

They will work properly if your table and field names match.

 

[Ken Sheridan]

That is true. In fact in practice I'd go even further, but did nor want to
overcomplicate things in my last post. I'd create a calendar table specific
to the workdays requirement by excluding the weekend days from it completely.
I created the following toolkit function many years ago for this purpose.
It allows a table of any set of days of the week to be created. Here's a DAO
version:

Public Function MakeCalendar_DAO(strtable As String, _
dtmStart As Date, _
dtmEnd As Date, _
ParamArray varDays() As Variant)

' Accepts: Name of calendar table to be created: String.
' Start date for calendar: DateTime.
' End date for calendar: DateTime.
' Days of week to be included in calendar
' as value list, e,g 2,3,4,5,6 for Mon-Fri
' (use 0 to include all days of week)

Dim dbs As DAO.Database, tdf As DAO.TableDef
Dim strSQL As String
Dim dtmdate As Date
Dim varDay As Variant
Dim lngDayNum As Long

Set dbs = CurrentDb

' does table exist? If so get user confirmation to delete it
On Error Resume Next
Set tdf = dbs.TableDefs(strtable)
If Err = 0 Then
If MsgBox("Replace existing table: " & _
strtable & "?", vbYesNo + vbQuestion, _
"Delete Table?") = vbYes Then
strSQL = "DROP TABLE " & strtable
dbs.Execute strSQL
Else
Exit Function
End If
End If
On Error GoTo 0

' create new table
strSQL = "CREATE TABLE " & strtable & _
"(calDate DATETIME, " & _
"CONSTRAINT PrimaryKey PRIMARY KEY (calDate))"
dbs.Execute strSQL

' refresh database window
Application.RefreshDatabaseWindow

If varDays(0) = 0 Then
' fill table with all dates
For dtmdate = dtmStart To dtmEnd
lngDayNum = lngDayNum + 1
strSQL = "INSERT INTO " & strtable & "(calDate) " & _
"VALUES(#" & Format(dtmdate, "mm/dd/yyyy") & "#)"

dbs.Execute strSQL
Next dtmdate
Else
' fill table with dates of selected days of week only
For dtmdate = dtmStart To dtmEnd
For Each varDay In varDays()
If Weekday(dtmdate) = varDay Then
lngDayNum = lngDayNum + 1
strSQL = "INSERT INTO " & strtable & "(calDate) " & _
"VALUES(#" & Format(dtmdate, "mm/dd/yyyy") & "#)"
dbs.Execute strSQL
End If
Next varDay
Next dtmdate
End If

End Function


And here's an ADO version:

Public Function MakeCalendar_ADO(strtable As String, _
dtmStart As Date, _
dtmEnd As Date, _
ParamArray varDays() As Variant)

' Accepts: Name of calendar table to be created: String.
' Start date for calendar: DateTime.
' End date for calendar: DateTime.
' Days of week to be included in calendar
' as value list, e,g 2,3,4,5,6 for Mon-Fri
' (use 0 to include all days of week)

Dim cmd As ADODB.Command
Dim cat As New ADOX.Catalog
Dim tbl As ADOX.Table
Dim strSQL As String
Dim dtmdate As Date
Dim varDay As Variant
Dim lngDayNum As Long

Set cmd = New ADODB.Command
cmd.ActiveConnection = CurrentProject.Connection
cmd.CommandType = adCmdText

Set cat = New Catalog
cat.ActiveConnection = CurrentProject.Connection

' does table exist? If so get user confirmation to delete it
On Error Resume Next
Set tbl = cat(strtable)
If Err = 0 Then
If MsgBox("Replace existing table: " & _
strtable & "?", vbYesNo + vbQuestion, _
"Delete Table?") = vbYes Then
strSQL = "DROP TABLE " & strtable
cmd.CommandText = strSQL
cmd.Execute
Else
Exit Function
End If
End If
On Error GoTo 0

' create new table
strSQL = "CREATE TABLE " & strtable & _
"(calDate DATETIME, " & _
"CONSTRAINT PrimaryKey PRIMARY KEY (calDate))"
cmd.CommandText = strSQL
cmd.Execute

' refresh database window
Application.RefreshDatabaseWindow

' refresh catalog
cat.Tables.Refresh

If varDays(0) = 0 Then
' fill table with all dates
For dtmdate = dtmStart To dtmEnd
lngDayNum = lngDayNum + 1
strSQL = "INSERT INTO " & strtable & "(calDate) " & _
"VALUES(#" & Format(dtmdate, "mm/dd/yyyy") & "#)"
cmd.CommandText = strSQL
cmd.Execute
Next dtmdate
Else
' fill table with dates of selected days of week only
For dtmdate = dtmStart To dtmEnd
For Each varDay In varDays()
If Weekday(dtmdate) = varDay Then
lngDayNum = lngDayNum + 1
strSQL = "INSERT INTO " & strtable & "(calDate) " & _
"VALUES(#" & Format(dtmdate, "mm/dd/yyyy") & "#)"
cmd.CommandText = strSQL
cmd.Execute
End If
Next varDay
Next dtmdate
End If

End Function


Ken Sheridan
Stafford, England

[...]
Please accept my sincere apology!

Fair enough; accepted. But if you didn't see my response in that other
thread, here's what it said:

<quote>
That is a *terribly* written function, but so far as I can tell it should
still work. I tested it, and didn't see the behavior you describe. It gave
the correct count, even when there were more than one holiday in the span of
dates.

</quote>

So while there are better ways to write that function -- and also Ken's
alternative approach of creating a table of pre-calculated dates, which has
its advantages and disadvantages -- that function as you originally posted
it should at least give you the right answer. I'd be interested to know
what you observed that made you think that it didn't. The basic algorithm
is sound. The only thing I can think of that could make it appear to give
an incorrect answer is something incorrect in the Holidays table, since we
can't see its design and don't know what records it contains.

--
Dirk Goldgar, MS Access MVP
www.datagnostics.com

(please reply to the newsgroup)

 

[Kevin]

Thanks Arvin,

I had tried this code earlier yesterday but coudlnt get it to work.

I tried it again now and it works like a dream.

Thanks again

That is poorly written and is bound to give you problems. Here is one that
adds or subtracts a number of working days, and allows for holidays,
including holidays that fall on weekends:

http://www.datastrat.com/Code/GetBusinessDay.txt

Here's a couple more that count the number of working days:

http://www.mvps.org/access/datetime/date0006.htm

They will work properly if your table and field names match.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com

Hi,

I have found this code to work out date difference (working days only) and
to include holidays from my [tblHolidays] table the code seems to work if
only one date in my holiday table falls between the [StartDate] and
[Enddate], but if there is more than one holiday date between [StartDate]
and
[EndDate] it only seems to take off the first. (I hope this makes sense!).

Could any tell me where I am going wrong Please?



Public Function CountWorkingDays(StartDate As Date, EndDate As Date) As
Integer

On Error GoTo ErrorHandler
'Get the number of workdays between the given dates
'function uses the Holidays table and deducts them from the days to allow
'for weekends
'and holidays when calculating deadline dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim lngIndex As Long
'Dim MyDate As Date
Dim lngNumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

Set dbs = CurrentDb
Set rstHolidays = dbs.OpenRecordset("Holidays", dbOpenDynaset)

NumSgn = Chr(35)

StartDate = Format(StartDate, "Short Date")

For lngIndex = CLng(StartDate) To CLng(EndDate)
Select Case (Weekday(StartDate))
Case Is = 1
'Do Nothing, it is Sunday
Case Is = 7
'Do Nothing, it is Saturday
Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & StartDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
lngNumDays = lngNumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If
End Select
StartDate = DateAdd("d", 1, StartDate)
Next lngIndex

CountWorkingDays = lngNumDays
Exit Function
ErrorHandler:
'on error destroy objects and exit function... The function will return
a zero value
Set rstHolidays = Nothing
Set dbs = Nothing
Exit Function
End Function