'------------------------------------- ' Creation date : 03/05/2017 (cn) ' Last update : 11/28/2018 (cn) ' Author(s) : Sekito.Lv ' Contributor(s): ' Tested on Excel 2016 '-------------------------------------

'------------------------------------- ' List of functions : ' - 1 - PublicHolidayFr ' - 2 - WorkingDay ' - 3 - WorkableDay ' - 4 - NextWorkingDay ' - 5 - NextWorkableDay ' - 6 - PrevWorkingDay ' - 7 - PrevWorkableDay '-------------------------------------

Option Explicit

'------------------------------------- ' Define all Constant variables '------------------------------------- Const WS_CONST_SHEET As String = "const" Const WS_ORIGINAL_DATA_SHEET As String = "Original" Const WS_DESIRED_OUT_SHEET As String = "Desired Output"

'------------------------------------------------------------------------------- ' The function PublicHolidayFr returns 1 if the date is a public holiday. ' If there is no DateDay parameter, the function returns 1 if the current date ' is a public holiday. ' Note : actually it's just for France '-------------------------------------------------------------------------------

Function PublicHolidayFr(Optional DateDay As Date) As Byte If DateDay = "00:00:00" Then DateDay = Date Dim res As Byte ' year Dim ye As Integer ye = year(DateDay) ' compute Paques day Dim Pa As Date Dim Mod4 As Integer, Mod7 As Integer, Mod9 As Integer Mod9 = (19 * (ye Mod 19) + 24) Mod 30 Mod4 = ye Mod 4 Mod7 = ye Mod 7 Pa = DateSerial(ye, 4, (Mod9 + (2 * Mod4 + 4 * Mod7 + 6 * Mod9 + 5) Mod 7) - 9) ' if Dateday is a public holiday Select Case DateDay Case Is = DateSerial(ye, 1, 1): res = 1 Case Is = DateSerial(ye, 5, 1): res = 1 Case Is = DateSerial(ye, 5, 8): res = 1 Case Is = DateSerial(ye, 7, 14): res = 1 Case Is = DateSerial(ye, 8, 15): res = 1 Case Is = DateSerial(ye, 11, 1): res = 1 Case Is = DateSerial(ye, 11, 11): res = 1 Case Is = DateSerial(ye, 12, 25): res = 1 Case Is = Pa: res = 1 ' Dimanche Paques Case Is = Pa + 1: res = 1 ' Lundi de Paques Case Is = Pa + 39: res = 1 ' Ascension Case Is = Pa + 49: res = 1 ' Pentecôte Case Is = Pa + 50: res = 1 ' Lundi de Pentecôte Case Else res = 0 End Select ' return result PublicHolidayFr = res End Function

'------------------------------------------------------------------------------- ' The function WorkingDay returns 1 if the date is a Working Day (Monday => Friday). ' If there is no DateDay parameter, the function returns 1 if the current date is a Working Day. '-------------------------------------------------------------------------------

Function WorkingDay(Optional DateDay As Date) As Byte If DateDay = "00:00:00" Then DateDay = Date Dim res As Byte Dim nda As Byte Dim phl As Byte phl = PublicHolidayFr(DateDay) nda = Weekday(DateDay, vbMonday) If (nda = 6 Or nda = 7 Or phl = 1) Then res = 0 Else res = 1 End If WorkingDay = res End Function

'------------------------------------------------------------------------------- ' The function WorkableDay returns 1 if the date is a Workable Day (Monday => Saturday). ' If there is no DateDay parameter, the function returns 1 if the current date is a Workable Day. '-------------------------------------------------------------------------------

Function WorkableDay(Optional DateDay As Date) As Byte If DateDay = "00:00:00" Then DateDay = Date Dim res As Byte Dim nda As Byte Dim phl As Byte phl = PublicHolidayFr(DateDay) nda = Weekday(DateDay, vbMonday) If (nda = 7 Or phl = 1) Then res = 0 Else res = 1 End If WorkableDay = res End Function

'------------------------------------------------------------------------------- ' The function NextWorkingDay returns the date in parameter if it's a Working Day and ' not a public holiday or the next Working Day if not. ' If there is no DateDay parameter, the function returns the next Working Day for the current date. '-------------------------------------------------------------------------------

Function NextWorkingDay(Optional DateDay As Date) As Date If DateDay = "00:00:00" Then DateDay = Date Dim res As Date Dim wda As Byte, wda1 As Byte, wda2 As Byte, wda3 As Byte, wda4 As Byte wda = WorkingDay(DateDay) wda1 = WorkingDay(DateDay + 1) wda2 = WorkingDay(DateDay + 2) wda3 = WorkingDay(DateDay + 3) wda4 = WorkingDay(DateDay + 4) If wda = 1 Then res = DateDay ElseIf wda1 = 1 Then res = DateDay + 1 ElseIf wda2 = 1 Then res = DateDay + 2 ElseIf wda3 = 1 Then res = DateDay + 3 ElseIf wda4 = 1 Then res = DateDay + 4 End If NextWorkingDay = res End Function

'------------------------------------------------------------------------------- ' The function NextWorkableDay returns the date in parameter if it's a Workable Day and ' not a public holiday or the next Workable Day if not. ' If there is no DateDay parameter, the function returns the next Workable Day for the current date. '-------------------------------------------------------------------------------

Function NextWorkableDay(Optional DateDay As Date) As Date If DateDay = "00:00:00" Then DateDay = Date Dim res As Date Dim wda As Byte, wda1 As Byte, wda2 As Byte, wda3 As Byte wda = WorkableDay(DateDay) wda1 = WorkableDay(DateDay + 1) wda2 = WorkableDay(DateDay + 2) wda3 = WorkableDay(DateDay + 3) If wda = 1 Then res = DateDay ElseIf wda1 = 1 Then res = DateDay + 1 ElseIf wda2 = 1 Then res = DateDay + 2 ElseIf wda3 = 1 Then res = DateDay + 3 End If NextWorkableDay = res End Function