Solved

Access 2003 UDF returning incorrect result

Posted on 2011-09-21
8
278 Views
Last Modified: 2012-05-12
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

0
Comment
Question by:bedsingar
  • 3
  • 3
  • 2
8 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility


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 & "#)) "
   
0
 

Author Comment

by:bedsingar
Comment Utility
Ahh ok... That makes sense - but now it's outputting 15 days! :s which is really confusing!
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
what is this date 1/12/2011 , mm/dd/yyyy  or dd/mm/yyyy ?

what is your default date format setting ?
0
 

Author Comment

by:bedsingar
Comment Utility
dd/mm/yyyy - The format is consistent throughout the database.

Thanks

Josh
0
Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

 
LVL 49

Accepted Solution

by:
Gustav Brock earned 500 total points
Comment Utility
Use:

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

/gustav
   
0
 
LVL 49

Expert Comment

by:Gustav Brock
Comment Utility
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
0
 

Author Closing Comment

by:bedsingar
Comment Utility
Perfect thank you, (just one extra closing parenthasis ))

Josh
0
 
LVL 49

Expert Comment

by:Gustav Brock
Comment Utility
You are welcome!

/gustav
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

In the previous article, Using a Critera Form to Filter Records (http://www.experts-exchange.com/A_6069.html), the form was basically a data container storing user input, which queries and other database objects could read. The form had to remain op…
Overview: This article:       (a) explains one principle method to cross-reference invoice items in Quickbooks®       (b) explores the reasons one might need to cross-reference invoice items       (c) provides a sample process for creating a M…
Basics of query design. Shows you how to construct a simple query by adding tables, perform joins, defining output columns, perform sorting, and apply criteria.
What’s inside an Access Desktop Database. Will look at the basic interface, Navigation Pane (Database Container), Tables, Queries, Forms, Report, Macro’s, and VBA code.

771 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

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now