Calculate working days between two dates problem!

[Jayz]

I got this code from the FAQ to calculate the days btwn two dates excluding holidays & weekends.

I created my table named tblHolidays with exact same field names.
On my Form I have 3 textboxes [StartDate] and [EndDate] and [numdays].
In the control source property of [numdays] I entered =DeltaDays([StartDate],[EndDate]).
I Entered the below code into a module.

Problem:
When I enter my dates, it calculates the total perfectly excluding the weekends. But when I enter Holidays to be excluded, into the tblHolidays table that are weekdays, it does not exclude these in the calculation.

What am I missing or done incorrectly?.

Regards,
Jay

tblHolidays:
***************
HoliDate HoliName
1/1/00 New Year's Day
1/17/00 Martin Luther King Day
2/2/00 Groundhog Day
2/12/00 Lincon's Birthday
2/14/00 Valentine's Day
2/21/00 President'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/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 Vetran's Day
11/23/00 Thanksgiving
12/25/00 Christmas
12/31/00 New Year's Eve


Entered into a module:
**************************
Public Function DeltaDays(StartDate As Date, EndDate As Date) As Integer

'Get the number of workdays between the given dates

Dim dbs As Database
Dim rstHolidays As Recordset

Dim Idx As Long
Dim MyDate As Date
Dim NumDays As Long
Dim strCriteria As String
Dim NumSgn As String * 1

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

NumSgn = Chr(35)

MyDate = Format(StartDate, "Short Date&quot

For Idx = CLng(StartDate) To CLng(EndDate)
Select Case (WeekDay(MyDate))
Case Is = 1 'Sunday
'Do Nothing, it is NOT a Workday

Case Is = 7 'Saturday
'Do Nothing, it is NOT a Workday

Case Else 'Normal Workday
strCriteria = "[HoliDate] = " & NumSgn & MyDate & NumSgn
rstHolidays.FindFirst strCriteria
If (rstHolidays.NoMatch) Then
NumDays = NumDays + 1
Else
'Do Nothing, it is NOT a Workday
End If

End Select

MyDate = DateAdd("d", 1, MyDate)

Next Idx

DeltaDays = NumDays

End Function

 

[Jayz]

Any help or reference to an alternative method would be much appreciated.

Jay.

 

[LarryDeLaruelle]

Jay:

I think I got the code for this from the same FAQ. Here is a function I wrote that does a calculation of workdays and takes into consideration any holidays in the date range.

Public Function WorkDays(StartDate As Date, EndDate As Date) As Integer
Dim dbTemp As Database
Dim rsTemp As Recordset
Dim strSQL As String

Dim lngLoop As Long
Dim datMyDate As Date
Dim intDays As Integer
Dim strCriteria As String
Dim strSign As String * 1 'The pound sign (#) for date strings

strSQL = "SELECT Holidate FROM tblHolidays WHERE Holidate >= " & Date - 7 & ";"
'The SQL string selects for any holidays within seven days prior to today's date

Set dbTemp = CurrentDb
Set rsTemp = dbTemp.OpenRecordset(strSQL)

strSign = Chr(35)
datMyDate = Format(StartDate, "Short Date&quot

For lngLoop = CLng(StartDate) To CLng(EndDate)
Select Case (WeekDay(datMyDate))
Case 1 'Sunday
'Do Nothing
Case 7 'Saturday
'Do Nothing
Case Else
strCriteria = "[Holidate] = " & strSign & datMyDate & strSign
rsTemp.FindFirst (strCriteria)
If (rsTemp.NoMatch) Then
intDays = intDays + 1
End If
End Select
datMyDate = DateAdd("d", 1, datMyDate)
Next lngLoop

WorkDays = intDays

End Function

This has worked fine for me. Hope it helps you. Larry De Laruelle
ldelaruelle@familychildrenscenter.org

 

[Jayz]

Larry, thanks for your response.

This is really spooking me now because I tried your code in a module and I still can't get the darn thing to work. I know that it definately is not your code, it has to be something I'm doing wrong or missing.

Here's what I did:
1) Created a table [tblHolidays] with 2 fields [Holidate] & [HoliName]. The [HoliDate] field is data type Date/Time with format Short Date.

2) Created a test form with 3 textboxes [StartDate] and [EndDate] and [numdays].
In the control source property of [numdays] I entered =workdays([StartDate],[EndDate]).

3)I enter into [StartDate] 23/12/02, and 26/12/02 into [EndDate](both these days are weekdays). I get the answer 4 days (which includes the first date). Excellent!!.

4)I now add the date 25/12/02 to tblHolidays and re-open the form & re-enter the same 2 dates. I still get 4 days instead of 3.

Please help this is really frustrating me.

Regards,
Jay

 

[Jayz]

OK, I've found a code that has worked for me. I'm still puzzled as to why the other two suggested codes did not work, hopefully someone can fill me in.

Anyway here's the one which I used thanks to Member PaulF's Post.

1)First create a table named tblHolidays with the two fields [Holidate] & [HoliName]. Make [HoliDate] a primary key for the function to check against. Enter any Dates you don't want to include in your calculation. eg

HoliDate HoliName
25/12/02 Christmas

2)Create the below function.

3) In your form Create 3 textboxes [StartDate] and [EndDate] and [numdays].
In the control source property of [numdays] enter "=DeltaDays([StartDate],[EndDate])",without the quotes.

And Bob's your Uncle!

Have Fun,
Jay

'********************************************
Function DeltaDays(BegDate, EndDate) As Long
On Error GoTo err_days
Dim db As Database
Dim Holidays As Recordset

Dim d As Long
Dim answer As Long

Set db = CurrentDb

Set Holidays = db.OpenRecordset("tblholidays&quot
Holidays.Index = "PrimaryKey"


answer = 0

'pick one:
'For d = BegDate To EndDate 'includes both end points
For d = BegDate + 1 To EndDate 'excludes BegDate
'For d = BegDate To EndDate - 1 'excludes EndDate
'For d = BegDate + 1 To EndDate - 1 'excludes both end points

If WeekDay(d) <> 1 And WeekDay(d) <> 7 Then 'if not a weekend
Holidays.Seek &quot;=&quot;, d

If Holidays.NoMatch Then 'not a holiday
answer = answer + 1
End If
End If

Next d

Holidays.Close
db.Close

DeltaDays = answer
Exit Function
err_days:
If Err.Number = 94 Then 'This eliminates the null error when fields
Exit Function 'have no dates entered yet or queries
Else

MsgBox Err.Number & &quot; : &quot; & Err.Description
Exit Function

End If
End Function

 

[MichaelRed]

The reason you get weird answers to my version of the function is the use of non-&quot;standard&quot; date format for the dates. MS &quot;CLEARLY&quot; states that only &quot;Standard&quot; (e.g. U.S. Date fomatted dates are acceptable in queries.


MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[Jayz]

Thanks Michael,
But I'd have to disagree with you there as I live in Australia and the standard format for dates here is dd/mm/yy.
This is the only query Where I have had problems with the date format. All other queries I have created worked fine.

 

[MichaelRed]

well, something needs to be awry in the holiday dates.

MichaelRed
m.red@att.net

There is never time to do it right but there is always time to do it over

 

[awiezzz]

Hi..
i've tried method above..but it doesn't work..please help me..when i run the form, [numdays] shows either #name or #error..please....i don't have any idea on how to solve this problem...it's very important to me..
your kindness was very much appreciated..

 

[GHolden]

Because of some odd problems with date formatting (uk format date problems) I use this which works similar except holiday dates are stored in text with no year (not as dates).

eg.

14/2 Valentines Day
25/12 Christmas Day

and the code is like this.

Public Function gintWorkDays(vdteStartDate As Date, vdteEndDate As Date) As Integer
Dim db As Database
Dim rstHolidays As Recordset
Dim lngLoop As Long
Dim dteDate As Date
Dim intDays As Integer
Dim strSQL As String

Set db = CurrentDb
Set rstHolidays = db.OpenRecordset(&quot;tblHoliday&quot;, dbOpenDynaset)

dteDate = Format(vdteStartDate, &quot;Short Date&quot

For lngLoop = CLng(vdteStartDate) To CLng(vdteEndDate)
Select Case (WeekDay(dteDate))
Case 1 'Sunday
'Do Nothing
Case 7 'Saturday
'Do Nothing
Case Else

strSQL = &quot;[HolidayDate] = '&quot; & DatePart(&quot;d&quot;, dteDate) & &quot;/&quot; & DatePart(&quot;m&quot;, dteDate) & &quot;'&quot;
rstHolidays.FindFirst (strSQL)
If (rstHolidays.NoMatch) Then
intDays = intDays + 1
End If

End Select

dteDate = DateAdd(&quot;d&quot;, 1, dteDate)

Next lngLoop

gintWorkDays = intDays

End Function

Maybe this will help

There are two ways to write error-free programs; only the third one works.

 

[cwbviper]

Hi there, i've got a similar problem and was wondering if anyone could help. I'm have created a form which will record a start date and return date for things such as maternity leave or contract ends or long term sickness. I was hoping to add in a function where i could somehow flag when the return date was approaching, either by sending an email to our company administrator or another form opening with a list of people due to return in the next month for example. I have no experience writing code so am pretty stuck, if anyone knows where i might be able to find some code which does any of the above it would be much appreciated if you let me know where.

Thanks

 

[MichaelRed]

Since you already have both dates, a simplistic approach would be to simply yse dateadd to add/subtract a number of days from one of the existing dates, There is a FAQ (faq705-3213) for the &quot;Due date&quot;, however it was not designed to deal w/ negative numbers of dates (i.e. days before some date). Still, you might be able to see the general approach used in either (actually both?) functions and derive your own procedure from the (simplistic) concept.

MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[cwbviper]

Thanks for the help MichaelRed.

Cheers