Solved: Date and Time Calculation

[d4vem]

Hi this is the first time I have used this site. I need help on the following issue if anyone is kind enough

I need to calculate the hours assigned between dates on a week ending basis (Friday being the last day of the week) over three months.

Example

Start Date = 23/05/06 09:00 End Date = 23/05/06 17:00 = 9 hours for week ending 26/05/06

Thats simple. What I am having problems with is the following;

Start Date = 23/05/06 09:00 End Date = 24/05/06 17:00 = (9 for 23/05/06 & 9 for 24/05/06) 18 hours for week ending 26/05/06

and this

Start Date = 23/05/06 09:00 End Date = 29/05/06 17:00 = 36 hours for week ending 26/05/06 & 9 hours for week ending 02/06/05 (as 29/05/06 is in the next week)

and this

Start Date = 23/05/06 09:00 End Date = 29/05/06 12:00 = Default times are 09:00 to 17:00 on each working day however on the last date for next week (02/06/05) it is due to be completed by 12:00 therefore 3 hours not the default of 9 hours. So I need to reflect for week ending 26/05/06 = 36 hours, week ending 02/06/05 = 3 hours

I do have the overall resource times. So for the last example I have a total of 39 hours.

Thanks in advance of a response

[mdmackillop]

Hi d4vem
Welcome to VBAX
Here's a UDF to calculate the hours. The only problem I have, is that up here in Bonnie Scotland, we usually count 9 to 5 as 8 hours and I've based my solution on that premise.

[vba]
Option Explicit
Function WorkTime(Data As Range)
Dim Strt As Double, Endd As Double
Dim Dys As Long, hrs As Double, i As Long

Strt = Data(1)
Endd = Data(2)
Dys = -1
For i = Int(Strt) To Int(Endd)
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
Dys = Dys + 1
End If
Next
hrs = ((Endd - Int(Endd)) - (Strt - Int(Strt))) * 24
WorkTime = Dys * 8 + hrs
End Function

[/vba]

[d4vem]

Thanks for the response it extracts the total work hours perfectly. However what I need to do is calculate the hours for each week.

In the attached file I have included your example and shown the breakdowns for each week. I have been trying to extract total hours per week unsuccessfully. Is there way to adapt the function or use the function with other formulas to achieve this?

Once again thanks for you swift response.

[mdmackillop]

Try this attachment

[d4vem]

Thanks very much for the response and hope you are having a good day. I have re attached the file you sent and added additional date ranges and times and it has created a bug see attachment. Column G cell 5 has a negative amount of hours can this get resolved by an if statement?

Hope it's warmer in bonny scotland than freezing down here!!!

Again thanks for your help

[mdmackillop]

Better, but not there yet. No more time just now. The problem lies with the Strt value (I think!)
[vba]
see below
[/vba]

[d4vem]

It still has the same result with a negative value in cell G5. Also if you drag and drop the comments field (reslt function) to cell J10 it states that no hours have been worked. Do the same for cell J11 it states over 3 weeks worked. I need this over 3 months or 12 weeks.

Thanks again for helping

[mdmackillop]

Add the following line before End Function
[VBA]
If WorkTime < 0 Then WorkTime = 0

[/VBA]
Regarding Reslt, did you think to change the formula when you added the extra columns?

[d4vem]

This looks excellant one last question. Is the function calculating at an eight hour working day duration for the week days in between the start and finish dates? but using the times for dates within the same week range?

[mdmackillop]

Yes to both.

[d4vem]

Thanks again

[d4vem]

Apologies I found a slight error in the function. Whe the start date is a Friday and the end date is greater than the next week it correctly calculates 8 hours for the first week and incorrectly 48 hours for the second week I have tried to change the function but cannot get the calculation working.

Thanks

[mdmackillop]

A slightly different logic, which I hope solves the problem
[vba]
see below
[/vba]

[mdmackillop]

[d4vem]

Apologies for the delayed response had a busy weekend. This worked a treat thanks again for your help.

[d4vem]

Thanks for the earlier help I have now gone into full testing mode and have experienced issues in the weekly calculations. I attach the file showing whats happening and that is the expected result that I was expecting to happen. Apologies for posting this back to the board after so long but I have users now testing and I am strugggling to make the necessary change required. I have included your original function and not my feeble attempts to change. Questions are hi lighted in red on the attachment, I would ideally prefer the actual daily time to be produced not a default 8 hours. Again thanks in advance of your reply.

[mdmackillop]

[VBA]Function WorkTime(Data1 As Range, Data2 As Range)
Dim Strt As Double, Endd As Double
Dim Dys As Long, hrs As Double, i As Long
Dim WeekEnd As Double, WeekStrt As Double
Dim DayStart As Long, DayEnd As Long

DayStart = 8: DayEnd = 17

Strt = Data1(1)
Endd = Data1(2)
WeekStrt = Data2 - 4 + (DayStart / 24)
WeekEnd = Data2 + (DayEnd / 24)

If WeekEnd < Strt Then
WorkTime = 0
Exit Function
End If
If Strt < WeekStrt Then Strt = WeekStrt
If WeekEnd < Endd Then Endd = WeekEnd
Dys = -1
For i = Int(Strt) To Int(Endd)
If Weekday(i) <> 1 And Weekday(i) <> 7 Then
Dys = Dys + 1
End If
Next
hrs = ((Endd - Int(Endd)) - (Strt - Int(Strt))) * 24
WorkTime = Dys * (DayEnd - DayStart) + hrs
If WorkTime <= 0.01 Then WorkTime = 0
End Function
[/VBA]

[d4vem]

Thankyou for your swift response.

This worked to resolve the problems I was having. However when I change the start time from 0800 to 0900 it is calculating incorrectly any ideas? I have attached the example.

Thanks

[d4vem]

Apologies looked at the function and all is clear. Thanks for the help

[d4vem]

Sorry so delayed in the response

I have attached a sample file it doesn't seem to calculate when the start date is the same date as the last date in that week