NetWorkHours() Not Working

B

brittaink

Registered User.
Local time
Today, 20:51
Joined
Dec 13, 2006
Messages
46
All,
Please can anyone let me know why this is not working? I have the following code as a module in my access database:

Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single
NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("05:00pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 9 Then
EndDayhours = 9
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i

'Calculate number of work hours
Select Case intGrossDays
Case 0
'start and end time on same day
NetWorkhours = intGrossHours
Case 1
'start and end time on consecutive days
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
Case Is > 1
'start and end time on non consecutive days
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
End Select
End Function

The actual function works fine, ALTHOUGH I have set-up an "Outage Calculator" for the line manager to use. It is really simple. Contains three text boxes that are not bound to a table.
Box 1 --- Date\Time_From
Box 2 --- Date\Time_To
Box 3 --- Networkhours([Date\Time_From],[Date\Time_To])

Default value for box 1 and box 2 is Now() so the Line manager just adjusts the time and dates to suit his needs eg.
Date From Date To Network Minutes
20/11/2009 08:50:22 20/11/2009 10:50:22 120

The problem that I have is it seems to be ignoring weekends for some reason. If I put in:

Date From Date To Network Minutes
14/11/2009 08:50:22 15/11/2009 08:50:22 499

The 14th and 15th are Saturday and Sunday. It should only raise minutes for weekdays.

Any Help would be much appreciated.

Keith
 
noone is going to respond to this because it is unreadable and because of that, incomprehensible. fix it and people will give you some help
 
Weekday(dteCurrDate, vbSaturday) < 3

Will make saturday 1 and sunday 2, which will make it ignore the saturday and sunday....

There is also a check for holidays with will make it skip holidays...
 
ajetrumpet said:
noone is going to respond to this because it is unreadable and because of that, incomprehensible. fix it and people will give you some help
Click to expand...

Apologies for the poor formatting, I didn't realise it had pasted in like that. The datasheet should look more like this

The actual function works fine, ALTHOUGH I have set-up an "Outage Calculator" for the line manager to use. It is really simple. Contains three text boxes that are not bound to a table.
Box 1 --- Date\Time_From
Box 2 --- Date\Time_To
Box 3 --- Networkhours([Date\Time_From],[Date\Time_To])

Default value for box 1 and box 2 is Now() so the Line manager just adjusts the time and dates to suit his needs eg.
Date From----------------- Date To ------------------Network Minutes
20/11/2009 08:50:22------ 20/11/2009 10:50:22 ------120

The problem that I have is it seems to be ignoring weekends for some reason. If I put in:

Date From----------------- Date To------------------ Network Minutes
14/11/2009 08:50:22------ 15/11/2009 08:50:22 ------499

The 14th and 15th are Saturday and Sunday. It should only raise minutes for weekdays.

Any Help would be much appreciated.

Keith
 
namliam said:
Weekday(dteCurrDate, vbSaturday) < 3

Will make saturday 1 and sunday 2, which will make it ignore the saturday and sunday....

There is also a check for holidays with will make it skip holidays...
Click to expand...

Thank You for your quick reply, The code already has the lines:

If Weekday(dteCurrDate, vbSaturday) < 3 Then nonWorkDays = nonWorkDays + 1
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i

Is this not the same as what you are saying?
 
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9

Is only beeing done in the more than 1 day option, if there is one day difference you do not account for "weekend" days...
 
namliam said:
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9

Is only beeing done in the more than 1 day option, if there is one day difference you do not account for "weekend" days...
Click to expand...

Thank You sooo much. I never spotted that. Sometimes the blindingly obvious escapes the untrained eye ha ha. Would I be right in saying that the code should look like this at the end?

'Calculate number of work hours
Select Case intGrossDays
Case 0
'start and end time on same day
NetWorkhours = intGrossHours
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
Case 1
'start and end time on consecutive days
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
Case Is > 1
'start and end time on non consecutive days
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
End Select
End Function
 
I havent made a study of the code, but try it...

And at the very least it should look like:
Code: 
'Calculate number of work hours
Select Case intGrossDays
    Case 0
        'start and end time on same day
        NetWorkhours = intGrossHours
        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
    Case 1
        'start and end time on consecutive days
        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
        NetWorkhours = NetWorkhours + StartDayhours
        NetWorkhours = NetWorkhours + EndDayhours
    Case Is > 1
        'start and end time on non consecutive days
        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
        NetWorkhours = NetWorkhours + StartDayhours
        NetWorkhours = NetWorkhours + EndDayhours
End Select

It could work, then again maybe not.... test it.
 
namliam,
Thank You for your help so far, but it is just coming out really confused now. I have inputted the code to see if it would work and it puts in -9 now so I looked at the code but I just can't get my head around it at the end. I know what you are saying with

NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9

Is only beeing done in the more than 1 day option, if there is one day difference you do not account for "weekend" days...
Click to expand...

But I can't see how to implement this. I am not up to the standard in VBA that I should probably be at, but there is only one way to learn. Do you have any idea's?

Keith
 
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9

Well.... intGrossDays is 1 (intGrossDays = DateDiff("d", (dteStart), (dteEnd)))
nonWorkdays is 1 (as per it is saturday)

1 - 1 - 1 = -1 * 9 = -9, makes perfect sence to me :)

The problem is in your logic, not the code itself... It basicaly assumes that the start day is a weekday.... not a weekend... or even holiday.
 
Thank you for your help so far. I have adjusted the code to the following:

Option Compare Database
Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single
NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("05:00pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 9 Then
EndDayhours = 9
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i

'Calculate number of work hours
Select Case intGrossDays

Case 0
'start and end time on same day
If Weekday(dteStart) = 7 Then
NetWorkhours = 0
if Weekday(dteEnd) = 1 Then
Networkhours = 0
Else
NetWorkhours = intGrossHours

End If

End If

Case 1
'start and end time on consecutive days
If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
NetWorkhours = 0

If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
NetWorkhours = NetWorkhours + EndDayhours

If Weekday(dteEnd) = 7 Then 'end date = Saturday so ignore last day
NetWorkhours = NetWorkhours + EndDayhours
Else
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
End If

End If

End If

Case Is > 1
If Weekday(dteStart) = 7 Then 'start date = saturday
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + EndDayhours

If Weekday(dteStart) = 1 Then 'start date = sunday
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + EndDayhours

If Weekday(dteEnd) = 7 Then 'end date = Saturday
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours

If Weekday(dteEnd) = 1 Then 'end date = Sunday
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours

Else
NetWorkhours = NetWorkhours - (nonWorkDays * 1)
NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours
End If

End If

End If

End If

End Select
End Function
Click to expand...

Obviously it still isn't working and I have actually ripped all of my hair out now. Sorry to sound lame but I have made up all of the script for the Case statements at the end and it does not come up with any errors, but seems to be coming up with Networkhours = 0 for nearly all date combinations now. Is there an easier or better, more correct way to write what I have written in the case statements?

Thank You
 
Last edited:
:eek: OK, I have gone and done some indenting for you....

:eek: You really really should make this a habbit ! As (to me) this makes it terribly obvious what/where the problem is.

Also please
1) use the code wraps not the quote wraps
2) use option explicit, this can be turned on by default Tools > Options > Editor Tab > Tick the "Require Variable Declaration"

Code: 
Option Compare Database
Option Explicit
Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

    Dim intGrossDays As Integer
    Dim intGrossHours As Single
    Dim dteCurrDate As Date
    Dim i As Integer
    Dim WorkDayStart As Date
    Dim WorkDayend As Date
    Dim nonWorkDays As Integer
    Dim StartDayhours As Single
    Dim EndDayhours As Single
    NetWorkhours = 0
    nonWorkDays = 0
    'Calculate work day hours on 1st and last day
    WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
    WorkDayend = DateValue(dteStart) + TimeValue("05:00pm")
    StartDayhours = DateDiff("n", dteStart, WorkDayend)
    EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
    'adjust for time entries outside of business hours
    If StartDayhours < 0 Then
        StartDayhours = 0
    End If
    If EndDayhours > 9 Then
        EndDayhours = 9
    End If
    'Calculate total hours and days between start and end times
    intGrossDays = DateDiff("d", (dteStart), (dteEnd))
    intGrossHours = 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
        If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
    Next i
    
    'Calculate number of work hours
    Select Case intGrossDays
        
        Case 0
            'start and end time on same day
            If Weekday(dteStart) = 7 Then
                NetWorkhours = 0
                If Weekday(dteEnd) = 1 Then
                    NetWorkhours = 0
                Else
                    NetWorkhours = intGrossHours
            
                End If
            
            End If
        
        Case 1
        'start and end time on consecutive days
            If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
                NetWorkhours = 0
        
                If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
                    NetWorkhours = NetWorkhours + EndDayhours
        
                    If Weekday(dteEnd) = 7 Then 'end date = Saturday so ignore last day
                        NetWorkhours = NetWorkhours + EndDayhours
                    Else
                        NetWorkhours = NetWorkhours + StartDayhours
                        NetWorkhours = NetWorkhours + EndDayhours
                    End If
        
                End If
        
            End If
        
        Case Is > 1
            If Weekday(dteStart) = 7 Then 'start date = saturday
                NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                NetWorkhours = NetWorkhours + EndDayhours
            
                If Weekday(dteStart) = 1 Then 'start date = sunday
                    NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                    NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                    NetWorkhours = NetWorkhours + EndDayhours
            
                    If Weekday(dteEnd) = 7 Then 'end date = Saturday
                        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                        NetWorkhours = NetWorkhours + StartDayhours
            
                        If Weekday(dteEnd) = 1 Then 'end date = Sunday
                            NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                            NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                            NetWorkhours = NetWorkhours + StartDayhours
            
                        Else
                            NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                            NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                            NetWorkhours = NetWorkhours + StartDayhours
                            NetWorkhours = NetWorkhours + EndDayhours
                        End If
                
                    End If
            
                End If
            
            End If
            
    End Select
End Function

I hope your mistake is more or less clear to you?

Tip: It has to do with the IF nesting.
 
Namliam,
I do use indents but when I pasted the code form Access module it does not include the indents. I have printed your code and compared it to the module on the database. There are no differences between the two. IT STILL DOES NOT WORK!! I have added the Option Explicit.

If you know why it does not work please tell me

Code: 
Option Compare Database
Option Explicit
Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single
NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("05:00pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 9 Then
EndDayhours = 9
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i

'Calculate number of work hours
Select Case intGrossDays

Case 0
    'start and end time on same day
    If Weekday(dteStart) = 7 Then
        NetWorkhours = 0
        If Weekday(dteEnd) = 1 Then
            NetWorkhours = intGrossHours
        Else
            NetWorkhours = intGrossHours
        End If
    End If

Case 1
    'start and end time on consecutive days
    If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
        NetWorkhours = 0
    
        If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
            NetWorkhours = NetWorkhours + EndDayhours
        
            If Weekday(dteEnd) = 7 Then  'end date = Saturday so ignore last day
                NetWorkhours = NetWorkhours + StartDayhours
            Else
                NetWorkhours = NetWorkhours + StartDayhours
                NetWorkhours = NetWorkhours + EndDayhours
            End If
    
        End If

    End If

Case Is > 1
    If Weekday(dteStart) = 7 Then 'start date = saturday
        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
        NetWorkhours = NetWorkhours + EndDayhours
    
        If Weekday(dteStart) = 1 Then 'start date = sunday
            NetWorkhours = NetWorkhours - (nonWorkDays * 1)
            NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
            NetWorkhours = NetWorkhours + EndDayhours
        
            If Weekday(dteEnd) = 7 Then  'end date = Saturday
                NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                NetWorkhours = NetWorkhours + StartDayhours
        
                If Weekday(dteEnd) = 1 Then  'end date = Sunday
                    NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                    NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                    NetWorkhours = NetWorkhours + StartDayhours
                Else
                    NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                    NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 9
                    NetWorkhours = NetWorkhours + StartDayhours
                    NetWorkhours = NetWorkhours + EndDayhours
                End If
    
            End If

        End If

    End If

End Select
End Function
 
brittaink said:
Namliam,
I do use indents but when I pasted the code form Access module it does not include the indents. I have printed your code and compared it to the module on the database. There are no differences between the two. IT STILL DOES NOT WORK!! I have added the Option Explicit.

If you know why it does not work please tell me
Click to expand...
Yes if you use Code tags its shows so, if you use Quote it doesnt... basicaly making your posted code quite unreadable.

And yes, all I did was indent it... changed nothing.

Your problem is in the nested if's like I hinted you earlier...
Code: 
If x = 1 Then 
    do something 
    ' only get here if x = 1
    if x = 2 then
        do something 
        ' only get here if x = 2
        if x = 3 then
etc...
        else
            Do Something
            ' Only get here if x not equal to 1 and 2 and 3....
etc...
That is what you have... you never get to the check where x=2 for anything that makes sense because x will only be 1 at that point.

Any other day will never end up in your "else" becuase of this same nesting problem... Instead (without detailed research though) it should look something like so:
Code: 
If x = 1 Then 
    do something 
    ' only get here if x = 1
[B]Else[/B] ' Not equal to 1 thus could be 2 or 3
        if x = 2 then
            do something 
            ' only get here if x = 2
    [B]Else[/B] 
            if x = 3 then
etc...
            else
                Do Something
etc...
Or use an elseif, something like so:
Code: 
If x = 1 Then 
    do something 
    ' only get here if x = 1
elseif x = 2 then
    do something 
    ' only get here if x = 2
elseif x = 3 then
etc...
else
    Do Something
    ' Only get here if x not equal to 1 and 2 and 3....
etc...

I hope that gives you the general idea :D
 
Namliam, or anybody,

Been working really hard on this with my limited knowledge. Still encountering a few problems.

Case1 and case>1 are still not working properly and I think although I am heading down the right road the code is still not entirely correct.

Please Note: Although the code title is NetworkHours I have * 540 to make it minutes in a 9 hour day so please ignore that.

Here is the final code that I have come to:

Code: 
Option Compare Database
Option Explicit
Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single
NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("17:00pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 9 Then
EndDayhours = 9
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i

'Calculate number of work hours
Select Case intGrossDays
Case 0
    'start and end time on same day
    If Weekday(dteStart) = 7 Then
        NetWorkhours = 0
    Else
        If Weekday(dteEnd) = 1 Then
            NetWorkhours = 0
        Else
            If dteStart < WorkDayStart And dteEnd > WorkDayend Then
                NetWorkhours = 540
            Else
                If dteStart > WorkDayStart And dteEnd > WorkDayend Then
                NetWorkhours = StartDayhours
                Else
                    If dteStart < WorkDayStart And dteEnd < WorkDayend Then
                    NetWorkhours = EndDayhours
                    Else
                        If dteStart > WorkDayStart And dteEnd < WorkDayend Then
                            NetWorkhours = intGrossHours
                        Else
                        MsgBox ("Aidan You Have Broken My Database Again. This is bad news")
                        End If
                    End If
                End If
             End If
        End If
    End If
    
Case 1
    'start and end time on consecutive days
    If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
        NetWorkhours = 0
    Else
        If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
            NetWorkhours = EndDayhours
        Else
            If Weekday(dteEnd) = 7 Then  'end date = Saturday so ignore last day
                NetWorkhours = StartDayhours
            Else
                NetWorkhours = NetWorkhours + StartDayhours
                NetWorkhours = NetWorkhours + EndDayhours
            End If
        End If
    End If
    
Case Is > 1
    If Weekday(dteStart) = 7 Or 1 And Weekday(dteEnd) = 7 Or 1 Then
        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
    Else
        If Weekday(dteStart) = 7 Then 'start date = saturday
            'NetWorkhours = NetWorkhours - (nonWorkDays * 1)
            NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
            NetWorkhours = NetWorkhours + EndDayhours
        Else
            If Weekday(dteStart) = 1 Then 'start date = sunday
                'NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
                NetWorkhours = NetWorkhours + EndDayhours
            Else
                If Weekday(dteEnd) = 7 Then  'end date = Saturday
                    NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                    NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
                    NetWorkhours = NetWorkhours + StartDayhours
                Else
                    If Weekday(dteEnd) = 1 Then  'end date = Sunday
                        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
                        NetWorkhours = NetWorkhours + StartDayhours
                    Else
                        NetWorkhours = NetWorkhours - (nonWorkDays * 1)
                        NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 540
                        NetWorkhours = NetWorkhours + EndDayhours
                        NetWorkhours = NetWorkhours + StartDayhours
                    End If
                End If
            End If
        End If
    End If
End Select
End Function

If anyone has any idea's Please let me know.

Thank You

Keith
 
Some things that jump to sight:
- You are not indenting properly (yes I nitpick, but it IS important to always do this)
- You changed to minutes over hours, then rename your function?
- You changed to minutes over hours, yet the initial settings are still hours: "EndDayhours = 9", doesnt make sence. You are beeing totaly inconsequent with this hours vs minutes thing.

I have an overall feeling like this is somewhat overly complex, but I would have to spend some time thinking about this to be able to rewrite this.
 
Namliam, Everyone

Although very crude I have finally cracked this bit of code with the help of another from my office.

If you wish to use this piece of code then please publish although I know that it could probably be re-written differently to suit different needs.

Code: 
Option Compare Database
Option Explicit
Public Function NetWorkminutes(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossMinutes As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayMinutes As Single
Dim EndDayMinutes As Single
NetWorkminutes = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("17:00pm")
StartDayMinutes = DateDiff("n", dteStart, WorkDayend)
EndDayMinutes = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayMinutes < 0 Then
StartDayMinutes = 0
End If
If EndDayMinutes > 540 Then
EndDayMinutes = 540
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossMinutes = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i
'Calculate number of work hours
Select Case intGrossDays
Case 0 ' start and end time on same day
    If Weekday(dteStart) = 7 Then 'if start day = saturday then is non working day so no hours to be recorded
        NetWorkminutes = 0
    Else
        If Weekday(dteEnd) = 1 Then 'if start day = sunday then is non working day so no hours to be recorded
            NetWorkminutes = 0
        Else
            If dteStart < WorkDayStart And dteEnd > WorkDayend Then
                NetWorkminutes = 540
            Else
                If dteStart > WorkDayStart And dteEnd > WorkDayend Then
                NetWorkminutes = StartDayMinutes
                Else
                    If dteStart < WorkDayStart And dteEnd < WorkDayend Then
                    NetWorkminutes = EndDayMinutes
                    Else
                        If dteStart > WorkDayStart And dteEnd < WorkDayend Then
                            NetWorkminutes = intGrossMinutes
                        Else
                        MsgBox ("Aidan You Have Broken My Database Again. This is bad news")
                        End If
                    End If
                End If
             End If
        End If
    End If
Case 1
    'start and end time on consecutive days
    If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
        NetWorkminutes = 0
    Else
        If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
            dteStart = DateAdd("d", 1, dteStart)
            NetWorkminutes = EndDayMinutes
        Else
            If Weekday(dteEnd) = 7 Then  'end date = Saturday so ignore last day
                dteEnd = DateAdd("d", -1, dteEnd)
                NetWorkminutes = StartDayMinutes
            Else
                NetWorkminutes = NetWorkminutes + StartDayMinutes
                NetWorkminutes = NetWorkminutes + EndDayMinutes
            End If
        End If
    End If
Case Is > 1
    If Weekday(dteStart) = 7 And Weekday(dteEnd) = 7 Then 'start = sat, end = sat
        dteStart = DateAdd("d", 2, dteStart)
        dteEnd = DateAdd("d", -1, dteEnd)
        NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
    Else
        If Weekday(dteStart) = 7 And Weekday(dteEnd) = 1 Then 'start = sat, end = sun
            dteStart = DateAdd("d", 2, dteStart)
            dteEnd = DateAdd("d", -2, dteEnd)
            NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
        Else
            If Weekday(dteStart) = 7 Then 'start = sat, end = mon - fri
                dteStart = DateAdd("d", 2, dteStart)
                NetWorkminutes = (intGrossDays - nonWorkDays) * 540
                NetWorkminutes = NetWorkminutes + EndDayMinutes
            Else
                If Weekday(dteStart) = 1 And Weekday(dteEnd) = 7 Then 'start = sun, end = sat
                    dteStart = DateAdd("d", 1, dteStart)
                    dteEnd = DateAdd("d", -1, dteEnd)
                    NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
                Else
                    If Weekday(dteStart) = 1 And Weekday(dteEnd) = 1 Then 'start = sun, end = sun
                        dteStart = DateAdd("d", 1, dteStart)
                        dteEnd = DateAdd("d", -2, dteEnd)
                        NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
                    Else
                        If Weekday(dteStart) = 1 Then 'start = sun, end = mon - fri
                            dteStart = DateAdd("d", 1, dteStart)
                            NetWorkminutes = (intGrossDays - nonWorkDays) * 540
                            NetWorkminutes = NetWorkminutes + EndDayMinutes
                        Else
                            If Weekday(dteEnd) = 7 Then  'end date = Saturday
                                NetWorkminutes = (intGrossDays - nonWorkDays) * 540
                                NetWorkminutes = NetWorkminutes + StartDayMinutes
                            Else
                                If Weekday(dteEnd) = 1 Then  'end date = Sunday
                                    NetWorkminutes = (intGrossDays - nonWorkDays) * 540
                                    NetWorkminutes = NetWorkminutes + StartDayMinutes
                                Else
                                    NetWorkminutes = (intGrossDays - 1 - nonWorkDays) * 540 ' mon-fri, to mon-fri
                                    NetWorkminutes = NetWorkminutes + EndDayMinutes
                                    NetWorkminutes = NetWorkminutes + StartDayMinutes
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If

End Select
End Function

Thank you all for your help.

Keith Brittain
 
Glad you have it working :) like you said there is probably easier way to do this... but its working :D

Good job !
 
Hi,

Can you please modify this code for working hours (From 9:00AM To 6:30PM)

Option Compare Database
Option Explicit
Public Function NetWorkminutes(dteStart As Date, dteEnd As Date) As Single

Dim intGrossDays As Integer
Dim intGrossMinutes As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayMinutes As Single
Dim EndDayMinutes As Single
NetWorkminutes = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("17:00pm")
StartDayMinutes = DateDiff("n", dteStart, WorkDayend)
EndDayMinutes = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours
If StartDayMinutes < 0 Then
StartDayMinutes = 0
End If
If EndDayMinutes > 540 Then
EndDayMinutes = 540
End If
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossMinutes = 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
If Not IsNull(DLookup("[HolDate]", "tblHolidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then nonWorkDays = nonWorkDays + 1
Next i
'Calculate number of work hours
Select Case intGrossDays
Case 0 ' start and end time on same day
If Weekday(dteStart) = 7 Then 'if start day = saturday then is non working day so no hours to be recorded
NetWorkminutes = 0
Else
If Weekday(dteEnd) = 1 Then 'if start day = sunday then is non working day so no hours to be recorded
NetWorkminutes = 0
Else
If dteStart < WorkDayStart And dteEnd > WorkDayend Then
NetWorkminutes = 540
Else
If dteStart > WorkDayStart And dteEnd > WorkDayend Then
NetWorkminutes = StartDayMinutes
Else
If dteStart < WorkDayStart And dteEnd < WorkDayend Then
NetWorkminutes = EndDayMinutes
Else
If dteStart > WorkDayStart And dteEnd < WorkDayend Then
NetWorkminutes = intGrossMinutes
Else
MsgBox ("Aidan You Have Broken My Database Again. This is bad news")
End If
End If
End If
End If
End If
End If
Case 1
'start and end time on consecutive days
If Weekday(dteStart) = 7 Then 'start date = saturday so end date would equal sunday
NetWorkminutes = 0
Else
If Weekday(dteStart) = 1 Then 'start date = sunday so ignore first day
dteStart = DateAdd("d", 1, dteStart)
NetWorkminutes = EndDayMinutes
Else
If Weekday(dteEnd) = 7 Then 'end date = Saturday so ignore last day
dteEnd = DateAdd("d", -1, dteEnd)
NetWorkminutes = StartDayMinutes
Else
NetWorkminutes = NetWorkminutes + StartDayMinutes
NetWorkminutes = NetWorkminutes + EndDayMinutes
End If
End If
End If
Case Is > 1
If Weekday(dteStart) = 7 And Weekday(dteEnd) = 7 Then 'start = sat, end = sat
dteStart = DateAdd("d", 2, dteStart)
dteEnd = DateAdd("d", -1, dteEnd)
NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
Else
If Weekday(dteStart) = 7 And Weekday(dteEnd) = 1 Then 'start = sat, end = sun
dteStart = DateAdd("d", 2, dteStart)
dteEnd = DateAdd("d", -2, dteEnd)
NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
Else
If Weekday(dteStart) = 7 Then 'start = sat, end = mon - fri
dteStart = DateAdd("d", 2, dteStart)
NetWorkminutes = (intGrossDays - nonWorkDays) * 540
NetWorkminutes = NetWorkminutes + EndDayMinutes
Else
If Weekday(dteStart) = 1 And Weekday(dteEnd) = 7 Then 'start = sun, end = sat
dteStart = DateAdd("d", 1, dteStart)
dteEnd = DateAdd("d", -1, dteEnd)
NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
Else
If Weekday(dteStart) = 1 And Weekday(dteEnd) = 1 Then 'start = sun, end = sun
dteStart = DateAdd("d", 1, dteStart)
dteEnd = DateAdd("d", -2, dteEnd)
NetWorkminutes = ((intGrossDays + 1) - nonWorkDays) * 540
Else
If Weekday(dteStart) = 1 Then 'start = sun, end = mon - fri
dteStart = DateAdd("d", 1, dteStart)
NetWorkminutes = (intGrossDays - nonWorkDays) * 540
NetWorkminutes = NetWorkminutes + EndDayMinutes
Else
If Weekday(dteEnd) = 7 Then 'end date = Saturday
NetWorkminutes = (intGrossDays - nonWorkDays) * 540
NetWorkminutes = NetWorkminutes + StartDayMinutes
Else
If Weekday(dteEnd) = 1 Then 'end date = Sunday
NetWorkminutes = (intGrossDays - nonWorkDays) * 540
NetWorkminutes = NetWorkminutes + StartDayMinutes
Else
NetWorkminutes = (intGrossDays - 1 - nonWorkDays) * 540 ' mon-fri, to mon-fri
NetWorkminutes = NetWorkminutes + EndDayMinutes
NetWorkminutes = NetWorkminutes + StartDayMinutes
End If
End If
End If
End If
End If
End If
End If
End If

End Select
End Function
Click to expand...
 
You must log in or register to reply here.

Similar threads

N
Solved Check If Date is a Bank Holiday
Replies
5
Views
1,648
Number11
N
M
VBA code not working after splitting DB
Replies
10
Views
1,890
Manos39
M
V
Trying to have a button on a form open a report with info from a list box
Replies
18
Views
2,207
moke123
moke123
AngelSpeaks
FE Database Still Experiencing Bloat
2
Replies
32
Views
4,273
arnelgp
arnelgp
L
Code for Business Hours -Help Please
2 3 4
Replies
67
Views
6,574
theDBguy
theDBguy

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom