Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17


Access 2003 UDF returning incorrect result

Posted on 2011-09-21
Medium Priority
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 ?
Industry Leaders: 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 51

Accepted Solution

Gustav Brock earned 2000 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 51

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 51

Expert Comment

by:Gustav Brock
ID: 36574640
You are welcome!


Featured Post

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

Question has a verified solution.

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

The Windows Phone Theme Colours is a tight, powerful, and well balanced palette. This tiny Access application makes it a snap to select and pick a value. And it doubles as an intro to implementing WithEvents, one of Access' hidden gems.
Code that checks the QuickBooks schema table for non-updateable fields and then disables those controls on a form so users don't try to update them.
In Microsoft Access, learn how to use Dlookup and other domain aggregate functions and one method of specifying a string value within a string. Specify the first argument, which is the expression to be returned: Specify the second argument, which …
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

688 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