asked on

Access 2003 UDF returning incorrect result

Hello,

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.

Thanks

Josh

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
      
      objRS1.MoveNext
    
    bankholidays = bankholidays + 1
      Loop
           
    '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)
   Loop

   Work_Days = WholeWeeks * 5 + EndDays - bankholidays

Exit Function

Err_Work_Days:

    ' 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
    Else
' If some other error occurs, provide a message.
    MsgBox "Error " & Err.Number & ": " & Err.Description
    End If

End Function

Open in new window

Rey Obrero (Capricorn1)

change this line

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

with

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

bedsingar

ASKER

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

Rey Obrero (Capricorn1)

what is this date 1/12/2011 , mm/dd/yyyy or dd/mm/yyyy ?

what is your default date format setting ?

bedsingar

ASKER

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

Thanks

Josh

ASKER CERTIFIED SOLUTION

Gustav Brock

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Gustav Brock

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
      Else
        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
  Do
    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)
  Wend

  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)
    Else
      ' Get preceding workday.
      datDate = DateAdd("d", cintWorkdaysOfWeek - bytWeekday, datDate)
    End If
  End If

  DateSkipWeekend = datDate

End Function

Open in new window

/gustav

bedsingar

ASKER

Perfect thank you, (just one extra closing parenthasis ))

Josh

Gustav Brock

You are welcome!

/gustav