Weekend Exclusion

[majid.pervaiz]

Dear Expert Friends,

I am a new user, I have followed from this forum and manage to calculate turn around time for tasks within department.
We have weekend here on Friday and Saturday, I believe the below code is for Saturday and Sunday...

can someone please help me to fix this issue to exclude Friday and Saturday from the total time calculation.


Public Function NetWorkhours(dteStart As Date, dteEnd As Date, Spellout As Boolean) As Variant
Dim intGrossDays As Integer
Dim intGrossMins As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayMins As Single
Dim EndDayMins As Single
Dim NetworkMins As Integer
NetworkMins = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("07:15:00")
WorkDayend = DateValue(dteStart) + TimeValue("14:30:00")
StartDayMins = DateDiff("n", dteStart, WorkDayend)
EndDayMins = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours

'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossMins = DateDiff("n", (dteStart), (dteEnd))
'count number of weekend days and holidays (from a table called "Holidays" that lists them)
For i = 0 To intGrossDays
dteCurrDate = dteStart + i
If Weekday(dteCurrDate, vbSaturday) < 3 Then
nonWorkDays = nonWorkDays + 1
Else
'If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then
'nonWorkDays = nonWorkDays + 1
'End If
End If
Next i
'Calculate number of work hours
Select Case intGrossDays
Case 0
'start and end time on same day
NetworkMins = (intGrossMins - ((nonWorkDays) * 1440))
Case 1
'start and end time on consecutive days
NetworkMins = StartDayMins + EndDayMins
Case Is > 1
'start and end time on non consecutive days
NetworkMins = (((intGrossDays - 1) - nonWorkDays) * 480) + (StartDayMins + EndDayMins)

End Select
If Spellout = True Then
NetWorkhours = MinsToTime(NetworkMins) ' hours and mins
Else
NetWorkhours = NetworkMins ' minutes only
End If


End Function
Function MinsToTime(Mins As Integer) As String
MinsToTime = Mins \ 60 & " hour" & IIf(Mins \ 60 <> 1, "s ", " ") & Mins Mod 60 & " minute" & IIf(Mins Mod 60 <> 1, "s", "")
End Function