I am sending you a revised function called WorkDaysT that allows you to input dates as text strings with your
dd/mmmm/yy format. The holidays table in my test routine is called THolidays. Details/comments are included in the code below.
The test routine calls WorkDaysT which in turn calls Weekdays. Weekdays has not been modified.
I have tested it with 0,1,2 and 3 holiday dates. The results are what I expected.
no holidays 20 workdays
holiday 26Jan 19 workdays
holiday 26Jan and 29Jan 18 workdays
holiday 26Jan, 29Jan and 30Jan -17 workdays
The logic of the workdays routine that you found does not consider a Holiday falling on a weekend???? If that is important, then additional testing/coding will be required.
Here is the revised code
Code:
'---------------------------------------------------------------------------------------
' Procedure : workdaysT
' Author : mellon
' Date : 26/01/2016
' Purpose : Pertains to
'https://www.accessforums.net/access/networkdays-vba-works-only-english-date-format-57718.html#post308940
'
'This is a modification to the Workdays function to allow strings representing Dates in dd/mmmm/yy format
'
' The strHolidays variable represents the name of the Holiday table. In this version that name is THolidays.
'I have made it the default name in the procedure call.
'
' The startdate and enddate have been changed to text/strings instead of the original Date datatype
'to accommodate your dd/mmmm/yy format.
'---------------------------------------------------------------------------------------
Public Function workdaysT(ByRef tstartDate As String, ByRef tendDate As String, _
Optional ByRef strHolidays As String = "THolidays") As Variant
On Error GoTo workdays_Error
Dim nWeekdays As Integer
Dim nHolidays As Integer
Dim strWhere As String
Dim startDate As Date
Dim endDate As Date
'convert string to real dates '*****************************
startDate = CDate(tstartDate)
endDate = CDate(tendDate)
' DateValue returns the date part only.
startDate = DateValue(startDate)
endDate = DateValue(endDate)
nWeekdays = Weekdays(startDate, endDate)
If nWeekdays = -1 Then
workdaysT = -1
GoTo Workdays_Exit
End If
strWhere = "[Holiday] >= #" & startDate & "# AND [Holiday] <= #" & endDate & "#"
' Count the number of holidays.
'
'Note - This function needs to know the name of the Holidays table and
' the name of the field containing the Holiday date in dd/mmmm/yy format.
nHolidays = DCount(expr:="[Holiday]", domain:=strHolidays, criteria:=strWhere)
workdaysT = nWeekdays - nHolidays
Workdays_Exit:
Exit Function
workdays_Error:
workdaysT = -1
MsgBox "Error " & Err.Number & ": " & Err.Description & " in procedure workdays of Module ModuleTesting_CanKill" _
, vbCritical, "WorkdaysT"
Resume Workdays_Exit
On Error GoTo 0
Exit Function
End Function
Weekdays (code unchanged)
Code:
'---------------------------------------------------------------------------------------
' Procedure : Weekdays
' Author : mellon
' Date : 26/01/2016
' Purpose : Note, this function is called by WorkDaysT, after the strings have been converted to Dates.
'So there is no need to modify the function parameters.
'---------------------------------------------------------------------------------------
'
Public Function Weekdays(ByRef startDate As Date, ByRef endDate As Date) As Integer
' Returns the number of weekdays in the period from startDate
' to endDate inclusive. Returns -1 if an error occurs.
' If your weekend days do not include Saturday and Sunday and
' do not total two per week in number, this function will
' require modification.
On Error GoTo Weekdays_Error
' The number of weekend days per week.
Const ncNumberOfWeekendDays As Integer = 2
' The number of days inclusive.
Dim varDays As Variant
' The number of weekend days.
Dim varWeekendDays As Variant
' Temporary storage for datetime.
Dim dtmX As Date
' If the end date is earlier, swap the dates.
If endDate < startDate Then
dtmX = startDate
startDate = endDate
endDate = dtmX
End If
' Calculate the number of days inclusive (+ 1 is to add back startDate).
varDays = DateDiff(Interval:="d", date1:=startDate, date2:=endDate) + 1
' Calculate the number of weekend days.
varWeekendDays = (DateDiff(Interval:="ww", date1:=startDate, date2:=endDate) * ncNumberOfWeekendDays) + IIf(DatePart(Interval:="w", Date:=startDate) = vbSunday, 1, 0) + IIf(DatePart(Interval:="w", Date:=endDate) = vbSaturday, 1, 0)
' Calculate the number of weekdays.
Weekdays = (varDays - varWeekendDays)
Weekdays_Exit:
Exit Function
Weekdays_Error:
Weekdays = -1
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Weekdays"
Resume Weekdays_Exit
End Function
Test routine to find workdays between 3/January/16 and 31/January/16 using the fictitious THolidays table and values.
Code:
'---------------------------------------------------------------------------------------
' Procedure : TestModifiedWorkdays
' Author : mellon
' Date : 26/01/2016
' Purpose :Routine to test the WorkDaysT function.
' I have mocked up a Holiday table called THolidays.
' table_name field_name
' tHolidays ID Long
' tHolidays Description Text
' tHolidays Holiday Text 255 Dates in dd/mmmm/yy format
'
'The Holidays(fictitious) for this test routine are
'
'ID Description Holiday
'1 MadeUpHoliday "26/january/16"
'2 AnotherHoliday "29/january/16"
'3 holidayOnWeekend "30/january/16"
'
' I am looking for workdays between 3/January/16 and 31/january/16
'---------------------------------------------------------------------------------------
'
Sub TestModifiedWorkdays()
Dim d1 As String
Dim d2 As String
On Error GoTo TestModifiedWorkdays_Error
d1 = "3/january/16"
d2 = "31/January/16"
Debug.Print workdaysT(d1, d2)
On Error GoTo 0
Exit Sub
TestModifiedWorkdays_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure TestModifiedWorkdays of Module ModuleTesting_CanKill"
End Sub
Windows 7 32bit 
Access 2013
Reply With Quote
Originally Posted by orange
