I found a module on this forum that provides me with a function to calculate the number of working hours between two dates/times. It works really well but now i need to be able to take out bank holidays/company shutdowns etc.
I have made up a table called "Holidays" with a field called HolDate. This field contains all of the dates i wish to remove in the uk date format of dd/mm/yyyy.
However i am ok at adapting bits of code but useless at writing it myself. The code i am using is posted below. Can anyone help me with an extra bit of code to remove these holiday dates?
Public Function WorkingHours(datBegin As Date, datEnd As Date) As Double
' Beginning and end of the day
Const tmecDayStart As Date = "6:30:00"
Const tmecDayEnd As Date = "15:30:00"
Dim datTotalTime As Date ' Running total of time worked
datTotalTime = 0 ' Initialized at 0
Dim datTest As Date ' Variable to keep the date where calculating
datTest = datBegin ' Initialized as the beginning date
' If the first day begins before 6:30, make it 6:30
If TimeValue(datTest) < tmecDayStart Then
datTest = DateValue(datTest) + TimeValue(tmecDayStart)
' If the first day begins after 15:30, make it 6:30 tomorow
ElseIf TimeValue(datTest) > tmecDayEnd Then
datTest = DateValue(datTest + 1) + TimeValue(tmecDayStart)
Else
' If the first day starts after 6:30 and before 15:30, make it 6:30
' and substract the difference to the running total
datTotalTime = datTotalTime - (TimeValue(datTest) - TimeValue(tmecDayStart))
datTest = DateValue(datTest) + TimeValue(tmecDayStart)
End If
' For every date
Do While DateValue(datTest) < DateValue(datEnd)
' Skip weekends
If Weekday(datTest, vbMonday) <= 5 Then
' Adds a complete day
datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
End If
' Iterate (adds a day)
datTest = datTest + 1
Loop
' Remove the time for the last incomplete day
' Skip the weekend
If Weekday(datTest, vbMonday) <= 5 Then
' If the last day ends before 6:30, add nothing
If TimeValue(datEnd) < tmecDayStart Then
' Do nothing
' If the last day ends after 1:30, add a day
ElseIf TimeValue(datEnd) > tmecDayEnd Then
' Adds a complete day
datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
' The last day ends between 6:30 and 15:00, add the time worked
Else
datTotalTime = datTotalTime + (TimeValue(datEnd) - TimeValue(tmecDayStart))
End If
End If
' Returns the number of minutes divided by 60, so it gives the number of hours
' I didn't returned DateDiff("h", CDate(0), datTotalTime) because Datediff returns a long.
WorkingHours = DateDiff("n", CDate(0), datTotalTime)
End Function
I would really appreciate any help!
I have made up a table called "Holidays" with a field called HolDate. This field contains all of the dates i wish to remove in the uk date format of dd/mm/yyyy.
However i am ok at adapting bits of code but useless at writing it myself. The code i am using is posted below. Can anyone help me with an extra bit of code to remove these holiday dates?
Public Function WorkingHours(datBegin As Date, datEnd As Date) As Double
' Beginning and end of the day
Const tmecDayStart As Date = "6:30:00"
Const tmecDayEnd As Date = "15:30:00"
Dim datTotalTime As Date ' Running total of time worked
datTotalTime = 0 ' Initialized at 0
Dim datTest As Date ' Variable to keep the date where calculating
datTest = datBegin ' Initialized as the beginning date
' If the first day begins before 6:30, make it 6:30
If TimeValue(datTest) < tmecDayStart Then
datTest = DateValue(datTest) + TimeValue(tmecDayStart)
' If the first day begins after 15:30, make it 6:30 tomorow
ElseIf TimeValue(datTest) > tmecDayEnd Then
datTest = DateValue(datTest + 1) + TimeValue(tmecDayStart)
Else
' If the first day starts after 6:30 and before 15:30, make it 6:30
' and substract the difference to the running total
datTotalTime = datTotalTime - (TimeValue(datTest) - TimeValue(tmecDayStart))
datTest = DateValue(datTest) + TimeValue(tmecDayStart)
End If
' For every date
Do While DateValue(datTest) < DateValue(datEnd)
' Skip weekends
If Weekday(datTest, vbMonday) <= 5 Then
' Adds a complete day
datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
End If
' Iterate (adds a day)
datTest = datTest + 1
Loop
' Remove the time for the last incomplete day
' Skip the weekend
If Weekday(datTest, vbMonday) <= 5 Then
' If the last day ends before 6:30, add nothing
If TimeValue(datEnd) < tmecDayStart Then
' Do nothing
' If the last day ends after 1:30, add a day
ElseIf TimeValue(datEnd) > tmecDayEnd Then
' Adds a complete day
datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
' The last day ends between 6:30 and 15:00, add the time worked
Else
datTotalTime = datTotalTime + (TimeValue(datEnd) - TimeValue(tmecDayStart))
End If
End If
' Returns the number of minutes divided by 60, so it gives the number of hours
' I didn't returned DateDiff("h", CDate(0), datTotalTime) because Datediff returns a long.
WorkingHours = DateDiff("n", CDate(0), datTotalTime)
End Function
I would really appreciate any help!
