Access 2003 UDF returning incorrect result

Posted on 2011-09-21
Last Modified: 2012-05-12

I am trying to create a new fuction which will work out the number of working days in a given month excluding bank holidays. Atatched is the VBA for the function, which correctly returns the number of working days, but doesn't pull back the bank holidays correctly and so returns a value of 0 for bankholidays.

The structure is as follows:

TBL015 has a configurable date field that could be set to any month.
TBL021 Has a list of all dates in the next 20 years and a mapping to it's fiscal period. (I.E the year starts April 5th)
TBL022 holds a list of bankholiday dates
QRY030 Works out the first date of each fiscal period.
QRY_TEMP Maps the date configured in TBL015 to a fiscal period using TBL021 then specifies the first day of that month using QRY030.

* I've shortened the table names to just their reference for simplicity.*

QRY_TEMP also will has an expression which calls the function, using the startdate to calculate the end of the period:
No_WorkDays: work_days([startofmonth],DateAdd("d",-1,DateAdd("m",1,[startofmonth])))

So Currently this function is set to use 1/12/2011 as startofmonth and so the end result should be 31 total days - 9 days of weekend - 2 days bankholiday. = 20 days, but the actual result returned is 22.

I think the error is probably with the ADO query but I can't spot it.

Any help you could provide would be much appreciated.


Option Compare Database

Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer

   '  This module requires references to the
'  following object libraries:
'  1. Microsoft Excel X.X Object Library,
'    where X.X is the Excel Version Number.
'  2. One of the following:
'    For mdb files:
'      Microsoft DAO 3.6 Object Library
'      (DAO360.DLL)
'    For ACCDB files (Access 2007):
'      Microsoft Office 12 Access Database Engine Objects
'      (ACEDAO.DLL)
'      This reference should be set already.
'  To set the reference, in the VBA editor:
'    Tools > References.
    '  DAO objects:
  Dim objDB As DAO.Database
  Dim objQDF As DAO.QueryDef
  Dim objRS1 As DAO.Recordset
  'SQL statements:
  Dim SSQL As String
   Dim WholeWeeks As Variant
   Dim DateCnt As Variant
   Dim EndDays As Integer, bankholidays As Integer
   On Error GoTo Err_Work_Days

'  Access constants:
Const strcQueryName As String = "TBL022_BankHolidays"

BegDate = DateValue(BegDate)
EndDate = DateValue(EndDate)
bankholidays = 0
'Get bank holidays between dates______________________________________________________________________________
  SSQL = "SELECT * FROM " & strcQueryName & " WHERE (((" & strcQueryName & ".Date)>=" & BegDate & " And (" & strcQueryName & ".Date)<=" & EndDate & ")) "
      '  Open a DAO recordset 5 on the query:
  Set objRS1 = CurrentDb.OpenRecordset(SSQL)
      Do Until objRS1.EOF
    bankholidays = bankholidays + 1
    'close recordset
  objRS1.Close '_________________________________________________________________________________
   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)

   Work_Days = WholeWeeks * 5 + EndDays - bankholidays

Exit Function


    ' If either BegDate or EndDate is Null, return a zero
    ' to indicate that no workdays passed between the two dates.

    If Err.Number = 94 Then
                Work_Days = 0
    Exit Function
' If some other error occurs, provide a message.
    MsgBox "Error " & Err.Number & ": " & Err.Description
    End If

End Function

Open in new window

Question by:bedsingar
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
  • 2
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36574160

change this line

  SSQL = "SELECT * FROM " & strcQueryName & " WHERE (((" & strcQueryName & ".Date)>=" & BegDate & " And (" & strcQueryName & ".Date)<=" & EndDate & ")) "


  SSQL = "SELECT * FROM " & strcQueryName & " WHERE (((" & strcQueryName & ".Date)>=#" & BegDate & "# And (" & strcQueryName & ".Date)<=#" & EndDate & "#)) "

Author Comment

ID: 36574236
Ahh ok... That makes sense - but now it's outputting 15 days! :s which is really confusing!
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 36574289
what is this date 1/12/2011 , mm/dd/yyyy  or dd/mm/yyyy ?

what is your default date format setting ?
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!


Author Comment

ID: 36574407
dd/mm/yyyy - The format is consistent throughout the database.


LVL 50

Accepted Solution

Gustav Brock earned 500 total points
ID: 36574499

SSQL = "SELECT * FROM " & strcQueryName & " WHERE ((" & strcQueryName & ".Date)>=#" & Format(BegDate, "yyyy\/mm\/dd") & "# And (" & strcQueryName & ".Date)<=#" & Format(EndDate, "yyyy\/mm\/dd") & "#))"

LVL 50

Expert Comment

by:Gustav Brock
ID: 36574549
Here's an alternative that will work in any non-English environment as well:
Public Function ISO_WorkdayDiff( _
  ByVal datDateFrom As Date, _
  ByVal datDateTo As Date, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Long

' Purpose: Calculate number of working days between dates datDateFrom and datDateTo.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' May be freely used and distributed.

' 1999-04-23. Gustav Brock, Cactus Data ApS, Copenhagen
' 2000-10-03. Constants added.
'             Option for 5 or 6 working days per week added.
' 2008-06-12. Option to exclude holidays from the count of workdays.
' 2011-06-08. Rewrite using Skip functions.

  Const cbytWorkdaysOfWeek  As Byte = 5
  ' Name of table with holidays.
  Const cstrTableHoliday    As String = "tblHoliday"
  ' Name of date field in holiday table.
  Const cstrFieldHoliday    As String = "HolidayDate"

  Dim booReverse            As Boolean
  Dim booSameWeekend        As Boolean
  Dim lngweeks              As Long
  Dim lngDays               As Long
  Dim lngHolidays           As Long
  Dim lngWorkdays           As Long
  Dim strDateFrom           As String
  Dim strDateTo             As String
  Dim strFilter             As String
  If WeekDay(datDateFrom, vbMonday) > cbytWorkdaysOfWeek And _
    WeekDay(datDateTo, vbMonday) > cbytWorkdaysOfWeek Then
    ' Both dates are of the same weekend.
    booSameWeekend = True
  End If
  Select Case DateDiff("d", datDateFrom, datDateTo)
    Case 0
      ' Zero days.
      Exit Function
    Case 1
      If booSameWeekend Then
        ' Both dates are of the same weekend.
        Exit Function
      End If
    Case -1
      If booSameWeekend Then
        ' Both dates are of the same weekend.
        Exit Function
        booReverse = True
      End If
    Case Is < -1
      ' Negative count.
      booReverse = True
    Case Else
      ' Positive count.
  End Select
  ' Adjust dates to skip weekends and holidays.
  datDateFrom = DateSkipNoneWorkingday(datDateFrom, booReverse)
  datDateTo = DateSkipNoneWorkingday(datDateTo, Not booReverse)
  ' Find count of full weeks.
  lngweeks = DateDiff("w", datDateFrom, datDateTo)
  ' Calculate number of working days between the two weekdays ignoring holidays.
  lngDays = WeekDay(datDateTo, vbMonday) - WeekDay(datDateFrom, vbMonday) _
    + cbytWorkdaysOfWeek * DateDiff("ww", DateAdd("ww", lngweeks, datDateFrom), datDateTo, vbMonday)
  If booExcludeHolidays Then
    strDateFrom = Format(datDateFrom, "yyyy\/mm\/dd")
    strDateTo = Format(datDateTo, "yyyy\/mm\/dd")
    strFilter = cstrFieldHoliday & " Between #" & strDateFrom & "# And #" & strDateTo & "# And Weekday(" & cstrFieldHoliday & ", 2) <= " & cbytWorkdaysOfWeek & ""
    lngHolidays = IIf(booReverse, -1, 1) * DCount("*", cstrTableHoliday, strFilter)
  End If
  ' Add number of working days between the weeks of the two dates.
  ' Deduct count of holidays.
  lngWorkdays = lngDays + cbytWorkdaysOfWeek * lngweeks - lngHolidays
  ISO_WorkdayDiff = lngWorkdays

End Function

Public Function DateSkipNoneWorkingday( _
  ByVal datDate As Date, _
  Optional ByVal booReverse As Boolean) _
  As Date

' Purpose: Calculate first working day following/preceding datDate.
' 2009-04-12. Gustav Brock, Cactus Data ApS, Copenhagen

  Dim datNext As Date
  Dim datTest As Date
  datNext = datDate
    datTest = datNext
    datNext = DateSkipHoliday(datTest, booReverse)
    datNext = DateSkipWeekend(datNext, booReverse)
  Loop Until DateDiff("d", datTest, datNext) = 0
  DateSkipNoneWorkingday = datNext

End Function

Public Function DateSkipHoliday( _
  ByVal datDate As Date, _
  Optional ByVal booReverse As Boolean) _
  As Date

' Purpose: Calculate first day following/preceding datDate if this is holiday.
' 2009-04-12. Gustav Brock, Cactus Data ApS, Copenhagen

  ' Adjust to fit your table of holidays.
  Const cstrHolidayTable  As String = "tblHoliday"
  Const cstrHolidayField  As String = "HolidayDate"
  While Not IsNull(DLookup(cstrHolidayField, cstrHolidayTable, cstrHolidayField & " = " & Format(datDate, "\#m\/d\/yyyy\#")))
    datDate = DateAdd("d", 1 - Abs(2 * booReverse), datDate)

  DateSkipHoliday = datDate

End Function

Public Function DateSkipWeekend( _
  ByVal datDate As Date, _
  Optional ByVal booReverse As Boolean) _
  As Date

' Purpose: Calculate first working day equal to or following/preceding datDate.
' Assumes: 5 or 6 working days per week. Weekend is (Saturday and) Sunday.
' Limitation: Does not count for public holidays.
' May be freely used and distributed.
' 1999-07-03, Gustav Brock, Cactus Data ApS, Copenhagen
  Const cintWorkdaysOfWeek As Integer = 5

  Dim bytSunday   As Byte
  Dim bytWeekday  As Byte
  bytSunday = WeekDay(vbSunday, vbMonday)
  bytWeekday = WeekDay(datDate, vbMonday)
  If bytWeekday > cintWorkdaysOfWeek Then
    ' Weekend.
    If booReverse = False Then
      ' Get following workday.
      datDate = DateAdd("d", 1 + bytSunday - bytWeekday, datDate)
      ' Get preceding workday.
      datDate = DateAdd("d", cintWorkdaysOfWeek - bytWeekday, datDate)
    End If
  End If

  DateSkipWeekend = datDate

End Function

Open in new window


Author Closing Comment

ID: 36574590
Perfect thank you, (just one extra closing parenthasis ))

LVL 50

Expert Comment

by:Gustav Brock
ID: 36574640
You are welcome!


Featured Post

Ransomware-A Revenue Bonanza for Service Providers

Ransomware – malware that gets on your customers’ computers, encrypts their data, and extorts a hefty ransom for the decryption keys – is a surging new threat.  The purpose of this eBook is to educate the reader about ransomware attacks.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
ms access - Helpdesk ticket system 5 53
Handle Apostrophes in SQL Parameter 16 68
Calculation in a Report 13 43
Best way to get data into a database 12 56
As tax season makes its return, so does the increase in cyber crime and tax refund phishing that comes with it
This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Familiarize people with the process of utilizing SQL Server functions from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Ac…
In Microsoft Access, learn the trick to repeating sub-report headings at the top of each page. The problem with sub-reports and headings: Add a dummy group to the sub report using the expression =1: Set the “Repeat Section” property of the dummy…

752 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question