Link to home
Start Free TrialLog in
Avatar of Mohammad Alsolaiman
Mohammad AlsolaimanFlag for Saudi Arabia

asked on

calculate future date (excluding weekends)?

Hi to every one
I need to calculate future date (excluding weekends).
I need to calculate the work days only.
= DateSerial(Year([dtStartDate]), Month([dtStartDate]), Day([dtStartDate]) + 7)
I need the future date  this number is weekdays only (excluding weekends).
For instance: let's say 2011/01/01 , add 7 workdays , it should give 2011/01/09.
Please help
Avatar of Gustav Brock
Gustav Brock
Flag of Denmark image

You can use this expression:

= ISO_WorkdayAdd(#2011/01/01#, 7)

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)
      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

Open in new window


/gustav
Avatar of jo_m
jo_m



Hello,

if it is just  straight  Workdays  you wish to add to your startd date this may be of help in a query.

 CalcEndDate:DateAdd("w",7,[tdStartDate])  

  this  should produce what you require.

I have attached a db with  a query  showing the result
Also in the source table I put a field for the time period you wish to add should you need differing times for each record

CalcEndDate:DateAdd("w",[tdperiod],[tdStartDate])

hope this is of some use


tx

Jo

calcWorkdays.mdb
Here's another approach ....  This is how I assign work order due dates that cannot fall on a Weekend.


Dim dteFuture As Date
dteFuture =dteStartDate + 7
If DatePart("w", dteFuture) = 7 Then   'Saturday - add 2 days bump to Monday
    dteFuture = dteFuture + 2
End If
If DatePart("w", dteFuture) = 1 Then   'Sunday - add 1 day bump to Monday
   dteFuture = dteFuture + 1
End If

Then populate whatever you need with dteFuture.


ET
Avatar of Mohammad Alsolaiman

ASKER

cactus_data:
i get this one "sub or function not define" and it points to "ISO_WorkdayDiff"
see the attach pls.
1.JPG
etsherman:
i put 2011/01/01 and i get 2011/01/01 ?!
see the attach pls
maybe there is something i have to change in the code, but actually i couldn't figure out.
2.JPG
jo_m:
good, but i need to calculate the 5 workdays a week only
this is my example again
"For instance: let's say 2011/01/01 , add 7 workdays , it should give 2011/01/09."
you can notice that 7 work days became 9 usual days.
> ..  "sub or function not define" and it points to "ISO_WorkdayDiff"
Of course, sorry. Here it is:
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.

  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 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

Open in new window


/gustav
Try this ...

Dim dteFuture As Date
dteFuture = DateSerial(Year([dtStartDate]), Month([dtStartDate]), Day([dtStartDate]) + 7)
If DatePart("w", dteFuture) = 7 Then   'Saturday - add 2 days bump to Monday
    dteFuture = dteFuture + 2
End If
If DatePart("w", dteFuture) = 1 Then   'Sunday - add 1 day bump to Monday
   dteFuture = dteFuture + 1
End If


ET

etsherman:  what if you are adding 30 or so days, ie, anything over a week?
>>>>>etsherman:  what if you are adding 30 or so days, ie, anything over a week? <<<<

The number of days you add should not make a difference.  Once added ...
DatePart("w", dteFuture) will return 1,2,3,4,5,6 or 7 (Sunday thru Saturday).

See below ...

Dim dteFuture As Date
dteFuture = DateSerial(Year([dtStartDate]), Month([dtStartDate]), Day([dtStartDate]) + 30)
If DatePart("w", dteFuture) = 7 Then   'Saturday - add 2 days bump to Monday
    dteFuture = dteFuture + 2
End If
If DatePart("w", dteFuture) = 1 Then   'Sunday - add 1 day bump to Monday
   dteFuture = dteFuture + 1
End If


ET
Another example , maybe I can make it more clear
WorkStartDate        AchievementEstematedDays  AchievementEstematedEndDate
2011/01/01             3 work days                                   2011/01/03  actually = 3 days
2011/01/05             5 work days                                   2011/01/11  actually = 7 days      
2011/01/15             11 work days                                 2011/01/29  actually = 15 days
2011/01/31              9 work days                                   2011/02/12 actually = 13 days
Please Notice that the week end days are Thursday and Friday.(not Saturday and Sunday).
thanks for effort
> the week end days are Thursday and Friday.(not Saturday and Sunday).

Well, that was new!
However, I modified the function to achieve this. Call it like this:

AchievementEstematedEndDate = ISO_Workday2Add(WorkStartDate, AchievementEstematedDays - 1)

Public Function ISO_Workday2Add( _
  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 Saturday.
'          Weekend is up to and including Friday.
' May be freely used and distributed.
' 2011-01-17. Gustav Brock, Cactus Data ApS, Copenhagen
  
' 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 bytSaturday             As Byte
  Dim bytFriday               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_Workday2Add
  
  datDateTo = datDateFrom
  lngWorkdays = lngWorkdaysAdd
  If bytWorkdaysOfWeek >= cbytWorkdaysCountMin And bytWorkdaysOfWeek <= cbytWorkdaysCountMax Then
    ' Find ISO weekday for Saturday.
    bytSaturday = WeekDay(vbSaturday, vbSaturday)
    ' Find ISO weekday for Friday.
    bytFriday = WeekDay(vbFriday, vbSaturday)
    ' Find ISO weekday for last workday.
    intWorkdayLast = bytSaturday + bytWorkdaysOfWeek - 1
    
    ' Find ISO weekday for date datDateTo.
    intWeekdayFirst = WeekDay(datDateTo, vbSaturday)
    ' Shift date datDateTo from weekend to Saturday.
    If intWeekdayFirst > intWorkdayLast Then
      If lngWorkdaysAdd >= 0 Then
        datDateTo = DateAdd("d", bytFriday - intWeekdayFirst + 1, datDateTo)
      Else
        datDateTo = DateAdd("d", intWorkdayLast - intWeekdayFirst, datDateTo)
      End If
      ' Find ISO weekday for shifted date datDateTo.
      intWeekdayFirst = WeekDay(datDateTo, vbSaturday)
    End If
    
    ' Calculate number of days date datDateTo shall be shifted.
    If lngWorkdaysAdd >= 0 Then
      ' Shift to proceeding Saturday in current week.
      intDaysShift = intWeekdayFirst - bytSaturday
    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_Workday2Diff(datDateFrom, datDateTo, True)
        datDateTo = DateAdd("d", lngWorkdays - lngWorkdaysDiff, datDateTo)
      Wend
    End If

  End If
  
  ISO_Workday2Add = datDateTo
  
Exit_ISO_Workday2Add:
  Exit Function
  
Err_ISO_Workday2Add:
  ' Date datDateTo + lngWorkdaysAdd is outside date range of Access.
  ' Return time zero, 00:00:00.
  Resume Exit_ISO_Workday2Add

End Function

Public Function ISO_Workday2Diff( _
  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 (Thursday and) Friday.
' May be freely used and distributed.

' 2011-01-17. Gustav Brock, Cactus Data ApS, Copenhagen

  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 bytFriday             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 Friday.
  bytFriday = WeekDay(vbFriday, vbSaturday)
  
  ' Find weekdays for the dates.
  intWeekdayDateFrom = WeekDay(datDateFrom, vbSaturday)
  intWeekdayDateTo = WeekDay(datDateTo, vbSaturday)
  
  ' Compensate weekdays' value for non-working days (weekends).
  intWeekdayDateFrom = intWeekdayDateFrom + (intWeekdayDateFrom = bytFriday)
  intWeekdayDateTo = intWeekdayDateTo + (intWeekdayDateTo = bytFriday)
  
  ' 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, vbSaturday, 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 & ", 6) <= " & cbytWorkdaysOfWeek & ""
    lngHolidays = DCount("*", cstrTableHoliday, strFilter)
  End If
  
  ISO_Workday2Diff = lngDays - lngHolidays

End Function

Open in new window


/gustav
Hello again
Gotcha
Sorry Missed the  Add 7 working days excluding weekends


So a  function in a query

calcEndDate:iif(Weekday(DateAdd("w",[diff],[tdStartDate])) = 1,DateAdd("w",[diff]+1,[tdStartDate]), iif(Weekday(DateAdd("w",[diff],[tdStartDate])) = 7,DateAdd("w",[diff]-1,[tdStartDate]),(DateAdd("w",[diff],[tdStartDate]))))

with  the option of  setting the time period for each record or all thru  with a quick update query allows a little more flexibility.

Additionally this is  set for  Sat being weekday  7 and Sun being Weekday 1
Did a quick check via workday num in QryChkNoWeekends  and there isn't a  1 or a 7 in sight
I did the dates to 21/03/2013 just for a little more confidenc
BTW 2011/01/09 is a  sunday :-(

I've ammended thefunction  hopefully its what you need.

tx  jo
sorry didn't get back sooner   lost connection yesterday

calcWorkdays.mdb
Ok, so you are using a different Weekend and you want to include the Work Start Date in the future date ....  Needed to know that in your opening post.

XX = the variable number of Achievement Estimated days you want to add.

Dim dteFuture As Date
dteFuture = DateSerial(Year([dtStartDate]), Month([dtStartDate]), Day(([dtStartDate])-1) + XX)
If DatePart("w", dteFuture) = 5 Then   'Thursday - add 2 days bump to Saturday
    dteFuture = dteFuture + 2
End If
If DatePart("w", dteFuture) = 6 Then   'Friday - add 1 day bump to Saturday
   dteFuture = dteFuture + 1
End If


ET
ASKER CERTIFIED SOLUTION
Avatar of Mohammad Alsolaiman
Mohammad Alsolaiman
Flag of Saudi Arabia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Create a small table named Nums with the integer field named Num containing the values 1 to the highest value you think may be required.  Now run:

SELECT Count(Num) FROM Nums WHERE DateSerial(Year(sDate),Month(sDate),Num) BETWEEN sDate and eDate AND
WeekDay( DateSerial(Year(sDate),Month(sDate),Num)) NOT IN (5,6);

You will be prompted for the two dates, enter accordingly and you should get the correct answer.
Have you tried it?
i will , soon in sha'a allah
> sorry , but none of the above is true!

Well, it is but you have to work a little yourself.

/gustav
i am forced to close the question
i am very sorry for late
some code was very complicated to me to understand.
even though the result was not correct.