UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
2 Pages V  1 2 >  (Go to first unread post)
   Reply to this topicStart new topic
> Problem Subtracting Dates Excluding Holidays And Weekends, Any Version    
 
   
AndrewRippon
post May 21 2020, 11:39 PM
Post#1



Posts: 7
Joined: 21-May 20



Hi,

This is my first post to UA, but I've enjoyed reading the forum for some time smile.gif

I'm using Microsoft Access for Microsoft 365 MSO (16.0.12827.20152) 32 bit on PCs running Windows 10 with Microsoft SQL Server Express (64-bit) 2014 version 12.0.5223.6 as my backend. The front-end is packaged as an ACCDE and distributed out to the various users.

I am trying to subtract 2 working days from a given date. This means skipping over any weekends or holidays. The weekend days are always Saturday and Sunday and the holidays are listed in a separate table. I'm using Gustav's functions: ISO_WorkdayDiff, ISO_WorkdayAdd and DateSkipWeekend. This seems to be working very well across the application except for the case when there is a holiday before the weekend and we are counting backwards. For example, ISO_WorkdayAdd(#3/06/2020#,-2,5,True) should result in 29-5-2020 as 1-6-2020 is a holiday here and is loaded in to the holiday table. Unfortunately it is returning 1-6-2020 and not 29-5-2020. Please see the module code below:

CODE
Option Compare Database

Public Function ISO_WorkdayAdd( _
  ByVal datDateFrom As Date, _
  ByVal lngWorkdaysAdd As Long, _
  Optional ByVal bytWorkdaysOfWeek As Byte = 5, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Date
' Purpose: Add number of working days to date datDateFrom.
' Assumes: 1 to 7 working days per week.
'          First workday is Monday.
'          Weekend is up to and including 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.
' 2002-01-10. Option for 1 to 7 working days per week added.
'             Allowed to add negative number of working days.
'             Adding of zero working days returns the next
'             working day if current day is not a working day.
' 2008-06-14. Option to add holidays in the period to the count of workdays.
  
' Test:
' For j = 0 To 10 : For i = 0 to 12 : ? j, i, ISO_WorkdayAdd(Date + j, i): Next i: Next j

  ' Minimum and maximum count of workdays per week.
  Const cbytWorkdaysCountMin  As Byte = 1
  Const cbytWorkdaysCountMax  As Byte = 7
  Dim datDateTo               As Date
  Dim bytMonday               As Byte
  Dim bytSunday               As Byte
  Dim intWeekdayFirst         As Integer
  Dim intWorkdayLast          As Integer
  Dim intDaysShift            As Integer
  Dim lngDays                 As Long
  Dim lngWeeks                As Long
  Dim lngWorkdays             As Long
  Dim lngWorkdaysDiff         As Long
  
  On Error GoTo Err_ISO_WorkdayAdd
  
  datDateTo = datDateFrom
  lngWorkdays = lngWorkdaysAdd
  If bytWorkdaysOfWeek >= cbytWorkdaysCountMin And bytWorkdaysOfWeek <= cbytWorkdaysCountMax Then
    ' Find ISO weekday for Monday.
    bytMonday = Weekday(vbMonday, vbMonday)
    ' Find ISO weekday for Sunday.
    bytSunday = Weekday(vbSunday, vbMonday)
    ' Find ISO weekday for last workday.
    intWorkdayLast = bytMonday + bytWorkdaysOfWeek - 1
    
    ' Find ISO weekday for date datDateTo.
    intWeekdayFirst = Weekday(datDateTo, vbMonday)
    ' Shift date datDateTo from weekend to Monday.
    If intWeekdayFirst > intWorkdayLast Then
      If lngWorkdaysAdd >= 0 Then
        datDateTo = DateAdd("d", bytSunday - intWeekdayFirst + 1, datDateTo)
      Else
        datDateTo = DateAdd("d", intWorkdayLast - intWeekdayFirst, datDateTo)
      End If
      ' Find ISO weekday for shifted date datDateTo.
      intWeekdayFirst = Weekday(datDateTo, vbMonday)
    End If
    
    ' Calculate number of days date datDateTo shall be shifted.
    If lngWorkdaysAdd >= 0 Then
      ' Shift to proceeding Monday in current week.
      intDaysShift = intWeekdayFirst - bytMonday
    Else
      ' Shift to succeeding last workday in current week.
      intDaysShift = intWeekdayFirst - intWorkdayLast
    End If
    ' Shift date datDateTo.
    datDateTo = DateAdd("d", -intDaysShift, datDateTo)
    ' Calculate workdays to add from start/end of current work week.
    lngWorkdaysAdd = lngWorkdaysAdd + intDaysShift
    
    ' Calculate number of workweeks and additional workdays to add.
    lngWeeks = lngWorkdaysAdd \ bytWorkdaysOfWeek
    lngDays = lngWorkdaysAdd Mod bytWorkdaysOfWeek
    
    ' Add number of calendar weeks and additional calendar days to
    ' shifted date datDateTo.
    If lngWeeks <> 0 Then
      datDateTo = DateAdd("ww", lngWeeks, datDateTo)
    End If
    If lngDays <> 0 Then
      datDateTo = DateAdd("d", lngDays, datDateTo)
    End If
    
    If booExcludeHolidays = True Then
      While lngWorkdays - lngWorkdaysDiff > 0
        lngWorkdaysDiff = ISO_WorkdayDiff(datDateFrom, datDateTo, True)
        datDateTo = DateAdd("d", lngWorkdays - lngWorkdaysDiff, datDateTo)
        datDateTo = DateSkipWeekend(datDateTo)
      Wend
    End If
  End If
  
  ISO_WorkdayAdd = datDateTo
  
Exit_ISO_WorkdayAdd:
  Exit Function
  
Err_ISO_WorkdayAdd:
  ' Date datDateTo + lngWorkdaysAdd is outside date range of Access.
  ' Return time zero, 00:00:00.
  Resume Exit_ISO_WorkdayAdd
End Function


Option Compare Database

Public Function ISO_WorkdayDiff( _
  ByVal datDateFrom As Date, _
  ByVal datDateTo As Date, _
  Optional ByVal booExcludeHolidays As Boolean) _
  As Long
'#39; 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.
  Const cbytWorkdaysOfWeek  As Byte = 5
  ' Name of table with holidays.
  Const cstrTableHoliday    As String = "dbo_tblHoliday"
  ' Name of date field in holiday table.
  Const cstrFieldHoliday    As String = "HolidayDate"
  Dim bytSunday             As Byte
  Dim intWeekdayDateFrom    As Integer
  Dim intWeekdayDateTo      As Integer
  Dim lngDays               As Long
  Dim datDateTemp           As Date
  Dim strDateFrom           As String
  Dim strDateTo             As String
  Dim lngHolidays           As Long
  Dim strFilter             As String
  
  ' Reverse dates if these have been input reversed.
  If datDateFrom > datDateTo Then
    datDateTemp = datDateFrom
    datDateFrom = datDateTo
    datDateTo = datDateTemp
  End If
  
  ' Find ISO weekday for Sunday.
  bytSunday = Weekday(vbSunday, vbMonday)
  
  ' Find weekdays for the dates.
  intWeekdayDateFrom = Weekday(datDateFrom, vbMonday)
  intWeekdayDateTo = Weekday(datDateTo, vbMonday)
  
  ' Compensate weekdays' value for non-working days (weekends).
  intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytSunday)
  intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytSunday)
  
  ' Calculate number of working days between the two weekdays, ignoring number of weeks.
  lngDays = intWeekdayDateTo - intWeekdayDateFrom - (cbytWorkdaysOfWeek * (intWeekdayDateTo < intWeekdayDateFrom))
  ' Add number of working days between the weeks of the two dates.
  lngDays = lngDays + (cbytWorkdaysOfWeek * DateDiff("w", datDateFrom, datDateTo, vbMonday, vbFirstFourDays))
  
  If booExcludeHolidays And lngDays > 0 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 = DCount("*", cstrTableHoliday, strFilter)
  End If
  
  ISO_WorkdayDiff = lngDays - lngHolidays
End Function

Option Compare Database

Public Function DateSkipWeekend( _
  ByVal datDate As Date, _
  Optional ByVal booReverse As Boolean) _
  As Date
'#39; 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
Go to the top of the page
 
FrankRuperto
post May 21 2020, 11:52 PM
Post#2



Posts: 1,099
Joined: 21-September 14
From: Tampa, Florida USA


Wouldn't it be easier to use a lookup table that only has working dates in it?
This post has been edited by FrankRuperto: May 21 2020, 11:53 PM

--------------------
Currently supporting pawnbrokers that use my store management system developed with Access 2010 on Windows7. Experienced with Informix, Oracle & PostgreSQL db's.
Go to the top of the page
 
Gustav
post May 22 2020, 05:47 AM
Post#3


UtterAccess VIP
Posts: 2,260
Joined: 21-February 07
From: Copenhagen


Those functions where updated some years ago:

CODE
' Returns the count of full workdays between Date1 and Date2.
' The date difference can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are regarded as workdays.
'
' Note that if one date is in a weekend and the other is not, the reverse
' count will differ by one, because the first date never is included in the count:
'
'   Mo  Tu  We  Th  Fr  Sa  Su      Su  Sa  Fr  Th  We  Tu  Mo
'    0   1   2   3   4   4   4       0   0  -1  -2  -3  -4  -5
'
'   Su  Mo  Tu  We  Th  Fr  Sa      Sa  Fr  Th  We  Tu  Mo  Su
'    0   1   2   3   4   5   5       0  -1  -2  -3  -4  -5  -5
'
'   Sa  Su  Mo  Tu  We  Th  Fr      Fr  Th  We  Tu  Mo  Su  Sa
'    0   0   1   2   3   4   5       0  -1  -2  -3  -4  -4  -4
'
'   Fr  Sa  Su  Mo  Tu  We  Th      Th  We  Tu  Mo  Su  Sa  Fr
'    0   0   0   1   2   3   4       0  -1  -2  -3  -3  -3  -4
'
' Execution time for finding working days of three years is about 4 ms.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateDiffWorkdays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Long
    
    Dim Holidays()      As Date
    
    Dim Diff            As Long
    Dim Sign            As Long
    Dim NextHoliday     As Long
    Dim LastHoliday     As Long
    
    Sign = Sgn(DateDiff("d", Date1, Date2))
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date2.
            Holidays = GetHolidays(Date1, Date2, False) 'CBool(Sign < 0))
            ' Ignore error when using LBound and UBound on an unassigned array.
            On Error Resume Next
            NextHoliday = LBound(Holidays)
            LastHoliday = UBound(Holidays)
            ' If Err.Number > 0 there are no holidays between Date1 and Date2.
            If Err.Number > 0 Then
                WorkOnHolidays = True
            End If
            On Error GoTo 0
        End If
        
        ' Loop to sum up workdays.
        Do Until DateDiff("d", Date1, Date2) = 0
            Select Case Weekday(Date1)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    If WorkOnHolidays = False Then
                        ' Check for holidays to skip.
                        If NextHoliday <= LastHoliday Then
                            ' First, check if NextHoliday hasn't been advanced.
                            If NextHoliday < LastHoliday Then
                                If Sgn(DateDiff("d", Date1, Holidays(NextHoliday))) = -Sign Then
                                    ' Weekend hasn't advanced NextHoliday.
                                    NextHoliday = NextHoliday + 1
                                End If
                            End If
                            ' Then, check if Date1 has reached a holiday.
                            If DateDiff("d", Date1, Holidays(NextHoliday)) = 0 Then
                                ' This Date1 hits a holiday.
                                ' Subtract one day to neutralize the one
                                ' being added at the end of the loop.
                                Diff = Diff - Sign
                                ' Adjust to the next holiday to check.
                                NextHoliday = NextHoliday + 1
                            End If
                        End If
                    End If
                    Diff = Diff + Sign
            End Select
            ' Advance Date1.
            Date1 = DateAdd("d", Sign, Date1)
        Loop
    End If
    
    DateDiffWorkdays = Diff

End Function


' Returns the holidays between Date1 and Date2.
' The holidays are returned as an array with the
' dates ordered ascending, optionally descending.
'
' The array is declared static to speed up
' repeated calls with identical date parameters.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function GetHolidays( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal OrderDesc As Boolean) _
    As Date()
    
    ' Constants for the arrays.
    Const DimRecordCount    As Long = 2
    Const DimFieldOne       As Long = 0
    
    Static Date1Last        As Date
    Static Date2Last        As Date
    Static OrderLast        As Boolean
    Static DayRows          As Variant
    Static Days             As Long
    
    Dim Records             As DAO.Recordset
    
    ' Cannot be declared Static.
    Dim Holidays()          As Date
    
    If DateDiff("d", Date1, Date1Last) <> 0 Or _
        DateDiff("d", Date2, Date2Last) <> 0 Or _
        OrderDesc <> OrderLast Then
        
        ' Retrieve new range of holidays.
        Set Records = DatesHoliday(Date1, Date2, OrderDesc)
        
        ' Save the current set of date parameters.
        Date1Last = Date1
        Date2Last = Date2
        OrderLast = OrderDesc
        
        Days = Records.RecordCount
        If Days > 0 Then
            ' As repeated calls may happen, do a movefirst.
            Records.MoveFirst
            DayRows = Records.GetRows(Days)
            ' Records is now positioned at the last record.
        End If
        Records.Close
    End If
    
    If Days = 0 Then
        ' Leave Holidays() as an unassigned array.
        Erase Holidays
    Else
        ' Fill array to return.
        ReDim Holidays(Days - 1)
        For Days = LBound(DayRows, DimRecordCount) To UBound(DayRows, DimRecordCount)
            Holidays(Days) = DayRows(DimFieldOne, Days)
        Next
    End If
        
    Set Records = Nothing
    
    GetHolidays = Holidays()
    
End Function


' Returns the holidays between Date1 and Date2.
' The holidays are returned as a recordset with the
' dates ordered ascending, optionally descending.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-18. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function DatesHoliday( _
    ByVal Date1 As Date, _
    ByVal Date2 As Date, _
    Optional ByVal ReverseOrder As Boolean) _
    As DAO.Recordset
        
    ' The table that holds the holidays.
    Const Table         As String = "Holiday"
    ' The field of the table that holds the dates of the holidays.
    Const Field         As String = "Date"
    
    Dim Records         As DAO.Recordset
    
    Dim SQL             As String
    Dim SqlDate1        As String
    Dim SqlDate2        As String
    Dim Order           As String
    
    SqlDate1 = Format(Date1, "\#yyyy\/mm\/dd\#")
    SqlDate2 = Format(Date2, "\#yyyy\/mm\/dd\#")
    ReverseOrder = ReverseOrder Xor (DateDiff("d", Date1, Date2) < 0)
    Order = IIf(ReverseOrder, "Desc", "Asc")
        
    SQL = "Select " & Field & " From " & Table & " " & _
        "Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
        "Order By 1 " & Order
        
    Set Records = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)
        
    Set DatesHoliday = Records
    
End Function


--------------------
Microsoft Office 365 (Access) MVP 2017 ->
Go to the top of the page
 
AndrewRippon
post May 24 2020, 04:22 PM
Post#4



Posts: 7
Joined: 21-May 20



Hi Gustav,

Thank you for your reply - much appreciated. Just one further question: Did you have an updated revision of the ISO_WorkDayAdd function or should I just re-point the original ISO_WorkDayAdd function to use the DateDiffWorkdays for it's calculations (rather than the original ISO_WorkdayDiff)? For what I'm doing (applying lead and lag time offsets to a production timings prediction), adding and subtracting, rather than knowing the number of working days, is the end goal.

Many Thanks

Andrew
Go to the top of the page
 
AndrewRippon
post May 24 2020, 04:30 PM
Post#5



Posts: 7
Joined: 21-May 20



Hi Frank,

It likely would, but at the moment the system is not aware of working days, only non-working days. It would be a great feature in the future, but it would require that a user set each working day in the year up, rather than just having a rule that says we don't work on the weekends and a table with half a dozen entries giving public holidays for a whole year. I can certainly see the advantages - we could add individual leave information and update capacities accordingly. It's probably not going to be something I would start on for some time though, as there are more pressing features to be implemented at the moment.

Good idea though!

Andrew

QUOTE
FrankRuperto Posted May 22 2020, 04:52 PM

Wouldn't it be easier to use a lookup table that only has working dates in it?

This post has been edited by AndrewRippon: May 24 2020, 04:52 PM
Go to the top of the page
 
FrankRuperto
post May 24 2020, 07:08 PM
Post#6



Posts: 1,099
Joined: 21-September 14
From: Tampa, Florida USA


Hi Andrew,

I was thinking you could easily populate a working dates lookup table with a query that inserts all dates where weekday equals Monday to Fridday for the current year, or a range of years, and then manually remove the handful of holidays. Another option is to leave all the dates and use an additional Yes/No field for the non-working dates. Having a lookup (fact) table also has its advantages, as you pointed out with the individual leave info example. Other fields can be added as well for added functionality.
This post has been edited by FrankRuperto: May 24 2020, 07:13 PM

--------------------
Currently supporting pawnbrokers that use my store management system developed with Access 2010 on Windows7. Experienced with Informix, Oracle & PostgreSQL db's.
Go to the top of the page
 
MadPiet
post May 24 2020, 08:33 PM
Post#7



Posts: 3,788
Joined: 27-February 09



Haven't used it in close to 20 years (wow, is it that long ago?!!), but when I had to do this, I used Arvin Meyer's code, which was here: http://www.datastrat.com/index.html Where it is now, though, I have no clue. I e-mailed him, but given that it's a holiday weekend, I don't expect he'll answer for a couple of days at least.
Go to the top of the page
 
Gustav
post May 25 2020, 02:38 AM
Post#8


UtterAccess VIP
Posts: 2,260
Joined: 21-February 07
From: Copenhagen


QUOTE
Did you have an updated revision of the ISO_WorkDayAdd function?

Yes I have:

CODE
' Adds Number of full workdays to Date1 and returns the found date.
' Number can be positive, zero, or negative.
' Optionally, if WorkOnHolidays is True, holidays are counted as workdays.
'
' For excessive parameters that would return dates outside the range
' of Date, either 100-01-01 or 9999-12-31 is returned.
'
' Will add 500 workdays in about 0.01 second.
'
' Requires table Holiday with list of holidays.
'
' 2015-12-19. Gustav Brock. Cactus Data ApS, CPH.
'
Public Function DateAddWorkdays( _
    ByVal Number As Long, _
    ByVal Date1 As Date, _
    Optional ByVal WorkOnHolidays As Boolean) _
    As Date
    
    Const Interval      As String = "d"
    
    Dim Holidays()      As Date

    Dim Days            As Long
    Dim DayDiff         As Long
    Dim MaxDayDiff      As Long
    Dim Sign            As Long
    Dim Date2           As Date
    Dim NextDate        As Date
    Dim DateLimit       As Date
    Dim HolidayId       As Long

    Sign = Sgn(Number)
    NextDate = Date1
    
    If Sign <> 0 Then
        If WorkOnHolidays = True Then
            ' Holidays are workdays.
        Else
            ' Retrieve array with holidays between Date1 and Date1 + MaxDayDiff.
            ' Calculate the maximum calendar days per workweek.
            MaxDayDiff = Number * DaysPerWeek / (WorkDaysPerWeek - HolidaysPerWeek)
            ' Add one week to cover cases where a week contains multiple holidays.
            MaxDayDiff = MaxDayDiff + Sgn(MaxDayDiff) * DaysPerWeek
            If Sign > 0 Then
                If DateDiff(Interval, Date1, MaxDateValue) < MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MaxDateValue)
                End If
            Else
                If DateDiff(Interval, Date1, MinDateValue) > MaxDayDiff Then
                    MaxDayDiff = DateDiff(Interval, Date1, MinDateValue)
                End If
            End If
            Date2 = DateAdd(Interval, MaxDayDiff, Date1)
            ' Retrive array with holidays.
            Holidays = GetHolidays(Date1, Date2)
        End If
        Do Until Days = Number
            If Sign = 1 Then
                DateLimit = MaxDateValue
            Else
                DateLimit = MinDateValue
            End If
            If DateDiff(Interval, DateAdd(Interval, DayDiff, Date1), DateLimit) = 0 Then
                ' Limit of date range has been reached.
                Exit Do
            End If
            
            DayDiff = DayDiff + Sign
            NextDate = DateAdd(Interval, DayDiff, Date1)
            Select Case Weekday(NextDate)
                Case vbSaturday, vbSunday
                    ' Skip weekend.
                Case Else
                    ' Check for holidays to skip.
                    ' Ignore error when using LBound and UBound on an unassigned array.
                    On Error Resume Next
                    For HolidayId = LBound(Holidays) To UBound(Holidays)
                        If Err.Number > 0 Then
                            ' No holidays between Date1 and Date2.
                        ElseIf DateDiff(Interval, NextDate, Holidays(HolidayId)) = 0 Then
                            ' This NextDate hits a holiday.
                            ' Subtract one day before adding one after the loop.
                            Days = Days - Sign
                            Exit For
                        End If
                    Next
                    On Error GoTo 0
                    Days = Days + Sign
            End Select
        Loop
    End If
    
    DateAddWorkdays = NextDate

End Function

--------------------
Microsoft Office 365 (Access) MVP 2017 ->
Go to the top of the page
 
AndrewRippon
post May 25 2020, 08:51 PM
Post#9



Posts: 7
Joined: 21-May 20



Hi Gustav,

Thank you for that. I've now got the GetHolidays, DatesHoliday, DateDiffWorkdays and DateAddWorkdays functions saved. However, upon looking at the code for DateAddWorkdays I noticed that there are 3 variables that are undeclared: DaysPerWeek, WorkDaysPerWeek and HolidaysPerWeek. I've declared DaysPerWeek as a Long and set it to 7, WorkDaysPerWeek as a Long and set it to 5. I wasn't immediately sure about HolidaysPerWeek. I'm assuming that it looks into the week that the Number parameter (of DateAddWorkdays) is in and gives the amount of holidays using a count of the recordset returned from the DatesHoliday function. Should I just write the code to support this or am I missing a key function in your set (I also haven't gone through all the other variables in DateAddWorkdays to check if they are declared yet)?

Thank you for your help so far - I'm sure I'll get there soon! smile.gif

Go to the top of the page
 
AndrewRippon
post May 25 2020, 08:57 PM
Post#10



Posts: 7
Joined: 21-May 20



Thanks MadPiet,

I wasn't expecting 3 solutions so fast - I'm used to solving everything myself! smile.gif

I'm surprised that Microsoft haven't made a built-in function to support this, but I guess the need to look up a separate holidays table takes it outside of what you'd normally expect them to provide.


QUOTE
MadPiet Posted Yesterday, 01:33 PM
Haven't used it in close to 20 years (wow, is it that long ago?!!), but when I had to do this, I used Arvin Meyer's code, which was here: http://www.datastrat.com/index.html Where it is now, though, I have no clue. I e-mailed him, but given that it's a holiday weekend, I don't expect he'll answer for a couple of days at least.
Go to the top of the page
 
AndrewRippon
post May 25 2020, 09:00 PM
Post#11



Posts: 7
Joined: 21-May 20



Hi Frank,

That would make the job a lot faster for the user. They would just have to enter (remove) information for the exceptions. I'll keep it in mind when I get there.

QUOTE
FrankRuperto Posted Yesterday, 12:08 PM
Hi Andrew,

I was thinking you could easily populate a working dates lookup table with a query that inserts all dates where weekday equals Monday to Fridday for the current year, or a range of years, and then manually remove the handful of holidays. Another option is to leave all the dates and use an additional Yes/No field for the non-working dates. Having a lookup (fact) table also has its advantages, as you pointed out with the individual leave info example. Other fields can be added as well for added functionality.
Go to the top of the page
 
FrankRuperto
post May 25 2020, 10:03 PM
Post#12



Posts: 1,099
Joined: 21-September 14
From: Tampa, Florida USA


QUOTE (Andrew's reply to MadPiet)
I'm surprised that Microsoft haven't made a built-in function to support this, but I guess the need to look up a separate holidays table takes it outside of what you'd normally expect them to provide.

That would be a nightmare for MS to maintain. In some countries like Japan, many people work 6 days a week. Different countries have different dates for same holidays, such as New Year's Day and Independence Day. Another factor is that organizations that provide essential services, such as military, police, fire, etc. and mission_critical such as cloud providers never apply non-working days globally.

QUOTE (Andrew's reply to Frank)
That would make the job a lot faster for the user. They would just have to enter (remove) information for the exceptions.

The main advantage of using a lookup table that contains all dates with a non-working day yes/no field is that you can make changes to it without having to modify any code. This is especially useful if for some reason at last minute the boss decides he wants everyone, or certain groups of workers, to work on a weekend, on Saturday's, a holiday, work a half day, etc. You can also have multiple non-working day yes/no fields for different groups of workers.
This post has been edited by FrankRuperto: May 25 2020, 10:06 PM

--------------------
Currently supporting pawnbrokers that use my store management system developed with Access 2010 on Windows7. Experienced with Informix, Oracle & PostgreSQL db's.
Go to the top of the page
 
Gustav
post May 26 2020, 02:34 AM
Post#13


UtterAccess VIP
Posts: 2,260
Joined: 21-February 07
From: Copenhagen


QUOTE
I noticed that there are 3 variables that are undeclared: DaysPerWeek, WorkDaysPerWeek and HolidaysPerWeek.

Sorry about that. Here they are (taken from a large block of constants):

CODE
' Common constants.
    
    ' Date.
    ' Workdays per week.
    Public Const WorkDaysPerWeek    As Long = 5
    ' Average count of holidays per week maximum.
    Public Const HolidaysPerWeek    As Long = 1

    Public Const DaysPerWeek        As Long = 7

--------------------
Microsoft Office 365 (Access) MVP 2017 ->
Go to the top of the page
 
tina t
post May 27 2020, 04:24 PM
Post#14



Posts: 6,685
Joined: 11-November 10
From: SoCal, USA


QUOTE
I am trying to subtract 2 working days from a given date. This means skipping over any weekends or holidays. The weekend days are always Saturday and Sunday and the holidays are listed in a separate table.

below is the code i've been using for the last 10+ years. i don't remember if i wrote it myself, or took a demo off the internet and tweaked it, so if somebody recognizes it as their code, my apologies and pls post your ownership. smile.gif the code could use some cleanup, and i've a 2nd version to add dates rather than subtract, which could probably be done in one procedure - i've just never go around to revisiting it.

maintenance is limited to updating the holidays table. each year when my employer's Accounting dept puts out next year's company calendar, i open the table and add the company holidays, usually about a dozen records; at the same time, i delete old records. so the table is tiny; never more than two dozen records or less.

hth
tina

CODE
Public Function calcNegDate(ByVal Dat As Date, ByVal intAdd As Integer) As Date

    Dim i As Integer, bump As Boolean, str As String
    Dim rst As DAO.Recordset, strSQL As String, rec As Boolean
    
    Dat = CDate(Fix(Dat))
    i = 1
    strSQL = "SELECT hDate FROM tbl00Holidays WHERE hDate Between #" & Dat & "# And #" & Dat - 45 & "#"
    Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
    
    rec = Not (rst.BOF And rst.EOF)
    
    If rec = True Then
        rst.MoveLast
        rst.MoveFirst
    End If
    
    For i = 1 To intAdd
        Dat = Dat - 1
        Do
            bump = False
            If rec = True Then
                rst.FindFirst "hDate = #" & Dat & "#"
                If rst.NoMatch = True Then
                    rst.MoveFirst
                Else
                    Dat = Dat - 1
                    bump = True
                End If
            End If
            
'            If DCount(1, "tbl00Holidays", "hDate = #" & dat & "#") > 0 Then
'                dat = dat + 1
'                bump = True
'            End If
            
            str = Format(Dat, "ddd")
            If str = "Sat" Then
                Dat = Dat - 1
                bump = True
            ElseIf str = "Sun" Then
                Dat = Dat - 2
                bump = True
            End If
        Loop Until bump = False
    Next
    
    rst.Close
    Set rst = Nothing
    calcNegDate = Dat

End Function

--------------------
"the wheel never stops turning"
Go to the top of the page
 
AndrewRippon
post May 27 2020, 11:49 PM
Post#15



Posts: 7
Joined: 21-May 20



Hi Gustav,

I've updated the code in DateAddWorkdays to so that it has the following added:

CODE
'Added by Andrew Rippon (must have been from another module Gustav wrote but we don't have??)
    'Length of week
    Dim DaysPerWeek     As Long
    'Working days in normal week
    Dim WorkDaysPerWeek As Long
    'Average count of holidays per week maximum
    Dim HolidaysPerWeek As Long
    'Not sure on this one - possibly sets a lower limit to what can be searched to speed things up?
    Dim MinDateValue As Date
'End Add

    Sign = Sgn(Number)
    NextDate = Date1
    
'Added by Andrew Rippon (must have been from another module Gustav wrote but we don't have??
    DaysPerWeek = 7
    WorkDaysPerWeek = 5
    HolidaysPerWeek = 1
    MinDateValue = #1/1/2018#
'End Add


You may notice that I have also added the MinDateValue variable as it also appears to be undeclared. Additional to this, the code in DatesHoliday seemed to have a bug in it that stopped the sorting from working correctly. I've changed it from:

CODE
    SQL = "Select " & Field & " From " & Table & " " & _
        "Where " & Field & " Between " & SqlDate1 & " And " & SqlDate2 & " " & _
        "Order By 1 " & Order


to the following:

CODE
    SQL = "SELECT " & Field & " FROM " & Table & " " & _
        "WHERE " & Field & " BETWEEN " & SqlDate1 & " AND " & SqlDate2 & " " & _
        "ORDER BY " & Field & " " & Order & ""


I'm not sure if I'm using MinDateValue correctly. Currently, the old "ISO" function I was using can count forwards correctly but not backwards, while the new DateAddWorkdays seems to ignoring holidays both forwards and backwards. I'm a bit stuck at this stage on your functions - it's more difficult for me to debug others' code.

I don't know if it is relevant, but here in New Zealand we write dates dd/mm/yyyy rather than the way the USA writes them (mm/dd/yyyy). Your code re-formats #yyyy/mm/dd# before processing, so it shouldn't be a problem.

Do you think it's worth persisting?
Go to the top of the page
 
Gustav
post May 28 2020, 02:16 AM
Post#16


UtterAccess VIP
Posts: 2,260
Joined: 21-February 07
From: Copenhagen


Tina, be very careful with such code, as it will fail in any non-English environment due to the localised names of weekdays.
Also, the implicit casting of date values to string will fail where the local date format is dd-mm-yyyy or similar as it is in most of Europe.

--------------------
Microsoft Office 365 (Access) MVP 2017 ->
Go to the top of the page
 
Gustav
post May 28 2020, 02:42 AM
Post#17


UtterAccess VIP
Posts: 2,260
Joined: 21-February 07
From: Copenhagen


Yes, all the constants (90+) and enums are held in a separate module from where I pull those needed.
The constants I missed here are these:

CODE
    Public Const MaxDateValue           As Date = #12/31/9999#
    Public Const MinDateValue           As Date = #1/1/100#
There is no reason to declare the constants as variables as they don't and must not change.

Also, there is no bug in the SQL. It pulls one field only. Thus, this is the only field to sort on, and "ORDER BY 1" specifies this.

Your local date format has no influence.

Finally, DateAddWorkdays only ignores holidays if you specifically ask it to do so by setting the third argument to True, like:

CODE
Workdays = DateAddWorkdays(56, #2/5/2020#, True)
So, double-check your Holiday table.



--------------------
Microsoft Office 365 (Access) MVP 2017 ->
Go to the top of the page
 
tina t
post May 28 2020, 02:04 PM
Post#18



Posts: 6,685
Joined: 11-November 10
From: SoCal, USA


hi Gustav, and thanks, that's a good warning for folks who may be affected by those issues. the code, of course, can be adjusted to meet local specifics. not everyone is writing apps that may be used around the world - a lot of us are writing apps that will be used where we are, and nowhere else.

QUOTE
the implicit casting of date values to string

not sure where the code is doing that. it doesn't affect my use, but i'd like to learn - will you help, pls?

tia, tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
FrankRuperto
post May 28 2020, 02:51 PM
Post#19



Posts: 1,099
Joined: 21-September 14
From: Tampa, Florida USA


QUOTE (tina)
the code, of course, can be adjusted to meet local specifics. not everyone is writing apps that may be used around the world - a lot of us are writing apps that will be used where we are, and nowhere else.

I cannot overstate that it's better to use a lookup table that contains all dates and boolean flags for the non-working days. Only one datasource is needed for working, and non-working weekends and holidays. Coding is a lot simpler and no coding mods are required if changes are made to the non-working day flags in the lookup table. This also allows for more granular customization in the event the business rules change.
This post has been edited by FrankRuperto: May 28 2020, 02:52 PM

--------------------
Currently supporting pawnbrokers that use my store management system developed with Access 2010 on Windows7. Experienced with Informix, Oracle & PostgreSQL db's.
Go to the top of the page
 
tina t
post May 28 2020, 04:36 PM
Post#20



Posts: 6,685
Joined: 11-November 10
From: SoCal, USA


guys, i didn't try to write, or post, code that will work for all situations, all over the world. i posted a simple procedure that's worked fine for my employer's local use for over 10 years, without any tweaking. if it works for somebody else's simple, local situation, fine. if not, this thread proves that there are many alternate methods that can be employed. if a guided missile is needed to kill a gnat, that's available. if all that's needed is a fly swatter, then a fly swatter can be used, or anything up to and including the guided missile. developer's choice.

hth
tina

--------------------
"the wheel never stops turning"
Go to the top of the page
 
2 Pages V  1 2 >


Custom Search


RSSSearch   Top   Lo-Fi    9th July 2020 - 05:22 AM