How can I exclude weekends and holidays when I calculate the due date?

batta
batta used Ask the Experts™
on
I need to return a value to DueDate depends on DateReceived and TurnRunTime(by day) excluding weekends and holidays. Please tell me how. Truly appreciated.
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
The function below works with a table and a query.

Cheers, Andrew

TABLE: USystblBankHoliday
BHDate Date/Time
BHDesc Text

QUERY: USysqryBankHolidayCount
PARAMETERS pdteStartDate DateTime, pdteEndDate DateTime;
SELECT Count(USystblBankHolidays.BHDate) AS QTY
FROM USystblBankHolidays
WHERE (((USystblBankHolidays.BHDate) Between [pdteStartDate] And [pdteEndDate]))
WITH OWNERACCESS OPTION;

Paste the following in a new module.

Function TextReport_NetWorkDays(BegDate As Variant, EndDate As Variant, Optional pbooIgnoreHolidays As Boolean) As Integer
Dim db As Database
Dim qd As QueryDef
Dim rst As Recordset

Dim WholeWeeks As Variant
Dim DateCnt As Variant
Dim EndDays As Integer
Dim Holidays As Long

    BegDate = Int(CDate(BegDate))
    EndDate = Int(CDate(EndDate))
   
    If pbooIgnoreHolidays Then
       Holidays = 0
    Else
       Set db = CurrentDb()
       Set qd = db.QueryDefs("USysqryBankHolidayCount")
       qd.Parameters!pdteStartDate = BegDate 'Format(BegDate, "dd/mmmm/yyyy")
       qd.Parameters!pdteEndDate = EndDate 'Format(EndDate, "dd/mmmm/yyyy")
       Set rst = qd.OpenRecordset()
       Holidays = rst!qty
       rst.Close
    End If
   
    WholeWeeks = DateDiff("w", BegDate, EndDate)
    DateCnt = DateAdd("ww", WholeWeeks, BegDate)
    EndDays = 0

    Do While DateCnt <= EndDate
       If Format(DateCnt, "ddd") <> "Sun" And Format(DateCnt, "ddd") <> "Sat" Then
          EndDays = EndDays + 1
       End If
   
       DateCnt = DateAdd("d", 1, DateCnt)
    Loop

    TextReport_NetWorkDays = WholeWeeks * 5 + EndDays - Holidays

End Function

Commented:
This question has been asked a few times lately. I answered it on a number of occasions with a complete solution using tables and functions, whuich because of the number of (like) questions I ended up putting into a demo database.

It is available if you like to email me (in profile).  NO CHARGE
Guy Hengel [angelIII / a3]Billing Engineer
Most Valuable Expert 2014
Top Expert 2009

Commented:
This is the comment from a new member having problems for posting. Please do not accept MY comment in case it solves your problem, but a new comment of <drallyn> as soon as he/she commented:


##### From: drallyn #####

I had to do something similar for a request tracking system.  We called it "Turnaround Time", but the concept is the same.  We used a "Request Date" and a "Completion Date", and had to figure out how many business days were in between those to dates.

I tested each day using the "DatePart()" function.  This function returns different parts of a Date value (the month, year, day, day of the year, --- and most important day of the week).  We can simply test the "day of the week" to see if it is a business day, and therefore eligible for our scenario...

In your case, we already know the time span, and want to figure out the duedate...  The principle remains, however, that we test if the test date is a business day, if it isn't don't count it...

This code will show you what I mean:

Function TurnRunTime_Date()
Dim tstDate As Date
Dim rcvdDate As Date
Dim DueDate As Date
Dim TRT As Long
Dim hdlr As Long


rcvdDate = #11/25/02#
tstDate = rcvdDate
TRT = 5

'assuming today is the first day
hdlr = 1

'the handler will increase if the day is a business day
'the test date will always increase regardless.
'if the test date isnt a business date, the handler wont increase
'but the test date will

While hdlr <> TRT
'this is the test -- "w" stands for "Day of the Week".
'1 = Sunday
'7 = Saturday
   If DatePart("w", tstDate) <> 1 And DatePart("w", tstDate) <> 7 Then
       hdlr = hdlr + 1
   End If
   tstDate = tstDate + 1
Wend

DueDate = tstDate
MsgBox rcvdDate & " plus " & TRT & " business days is " & DueDate
End Function

Holidays could be a little trickier, but you could create an array variable that would also be tested in your "While...Wend" loop.

Declare your array variable like this...

Dim Holidays(4) as Date
Dim Holiday as Variant

'New Years
Holidays(0) = #1/1/03#
'Easter
Holidays(1) = #4/20/03#
'Independance Day
Holidays(2) = #7/4/03#
'Thanksgiving
Holidays(3) = #11/27/03#
'Christmas
Holidays(4) = #12/31/03#

Then inside your "While...Wend" loop stick another couple pieces in...  We'll use the "For Each...Next" loop to test all of the members (or each "Holiday") of "Holidays" array...

This is what it might look like...

While hdlr <> TRT
   If DatePart("w", tstDate) <> 1 And DatePart("w", tstDate) <> 7 Then

'test within the If...Then statement
'because we know this is already a business day and eligible for a TRT day
'we will skip the TRT calc if our test date is a holiday

      For Each Holiday in Holidays
          If tstDate = Holiday Then Goto SkipTRT_add
      Next Holiday
      hdlr = hdlr + 1

SkipTRT_add:
   End If
   tstDate = tstDate + 1
Wend

Just some ideas to get you rolling. Let me know how it works.

#####
Ensure you’re charging the right price for your IT

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden using our free interactive tool and use it to determine the right price for your IT services. Start calculating Now!

To tun the function you can

In a query create a calculated field NoOfDays: TextReport_NetWorkDays([StartDate], [EndDate])
In a control on a form or report you can set the control source to =TextReport_NetWorkDays([txtStartDate], [txtEndDate])
To test then in the immediate window you can say ?TextReport_NetWorkDays(Date(),Date()-100)

Cheers, Andrew
No comment has been added lately, so it's time to clean up this TA.
I will leave a recommendation in the Cleanup topic area that this question is:
Answered: TextReport
Please leave comments here within the next seven days.

PLEASE DO NOT ACCEPT THIS COMMENT AS AN ANSWER !

nexus
EE Cleanup Expert for Microsoft Access
per recommendation

SpideyMod
Community Support Moderator @Experts Exchange

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial