Full Version: Counting Days With Sat, Sun, and holidays
UtterAccess Discussion Forums > Microsoft® Access > Access Date + Time
Brandi
UA members helped me many months ago with code to count days including Sat and Sundays as counting for a day except at the end when the end date falls on a Sat or Sunday in which case the end date is moved to Monday.

It is now many months later and my customer is changing their rule.
If the end date turns out to fall on a Sat or Sunday then the current code moves the end date to a Monday.
Now, however, they are telling me if the end date falls on a Sat or Sunday, then they want the previous Friday to be the end date.
I was not sure how to modify the code below because if the weekday = 6, then I would want to subtract 1 from the end date but if the weekday = 7 then I would want to subtract 2 from the enddate. I can verbalize this but now sure how to put that into the code.

'Make sure the end day is NOT a Saturday/Sunday
Do Until Weekday(dtEndDate, vbMonday) < 6 '6th day of the week with Mon as first day
dtEndDate = dtEndDate + 1
Loop

'Make sure the end day is NOT a holiday
Do Until DCount("*", "tblHolidays", "[HolidayDate]=#" & dtEndDate & "#" & _
" And Weekday([HolidayDate],1) Not In (1,7)") = 0
dtEndDate = dtEndDate + 1
Loop

'Once we are out of the loop, the end date should be set to the correct date
AddWorkDaysWithSatSun = dtEndDate

Thank you for your help.
Brandi
Doug Steele
CODE
  If Weekday(dtEndDate) = vbSaturday Then
    AddWorkDaysWithSatSun = dtEndDate - 1
  ElseIf Weekday(dtEndDate) = vbSunday Then
    AddWorkDaysWithSatSun = dtEndDate - 2
  Else
    AddWorkDaysWithSatSun = dtEndDate
  End If


Or

CODE
  AddWorkdaysWithSatSun = dtEndDate - Choose(Weekday(dtEndDate), 2, 0, 0, 0, 0, 0, 1)


Brandi
Works great. Thank you so much. I wasn't sure what to do about the Loop. Taking the loop out and using your code makes sense.
Brandi
Doug Steele
Actually, you still need the loop. My two suggestions replace a single line of code in your existing routine:

AddWorkDaysWithSatSun = dtEndDate

Brandi
Actually, there is a lot of code that I did not include in the snippet for this thread. AddWorkDaysWithSatSun is set before this part of the code. So, the way I used it, I was able to remove the loop and used the following based on your code. And then AddWorkDaysWithSatSun is added to dtEndDate after this piece and after checking to see if the date ended on a Holiday.
If Weekday(dtEndDate) = vbSaturday Then
dtEndDate = dtEndDate - 1
ElseIf Weekday(dtEndDate) = vbSunday Then
dtEndDate = dtEndDate - 2
End If

Seems to work so I guess I won't mess with it!
Thanks again.
Brandi
Gustav
You should have had my old function below. Then all you had to do was flipping a parameter!
Note the old trick to use Monday as the first day of the week to make it easy to determine the last days (the weekend) of the week.

/gustav


CODE
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
Brandi
Thank you. This code is very compact and I think I understand it. (not an expert at code)
I'll give it a try.

Brandi
This is a "lo-fi" version of our main content. To view the full version with more information, formatting and images, please click here.