calculate hours using start time & end time, excluding weekends

[noname]

Hi,

i am trying to calculate using VBA, the no of shift hours worked per
day.

each day hours =9 hrs.
shift starttime =9:00 am & shift endtime=6:00 pm.(total 9 hrs in a
day)

e.g:
===
I got some work on Thursday 5:00 PM and if we finish it on Friday 6:00
PM than it will be considered as 1 Day 1 hour job
thursday - 6:00 PM-5:00 PM=1hr
friday - 6:00 PM-9:00 AM=9 hrs
total=10 hrs or 1 Day 1 hour

Things to be considered while writing the code:
1 Day = (9 AM to 6:00 PM) - that's our shift timing.
*** Weekends should be excluded (for ex: if we got some work on Friday
5:00 PM) and we finishes the work on Monday 01:00PM) than this should
be considered within one day only [Friday 1 hour (06:00 PM - 05:00 PM)
+ Monday 4 hours (1:00 PM - 9:00 AM)

The total productive hours for each day should lie between 9:00
am-6:00 pm, excluding weekends(saturday & sunday).

i am able to calculate the no of days worked excluding weekends using
a do while & select case using weekday function like this:

Module1 Code
=====================
Function TurnaroundTime(startdate As Date, enddate As Date, stime As
Date, etime As Date)
On Error GoTo dt_err

Dim days, hr
Dim starttime, endtime

Set starttime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_start")
Set endtime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_end")
days = 0
hr = 0

Do While startdate <= enddate
Select Case Weekday(startdate)
Case Is = 1, 7
days = days
' hr = hr

Case Is = 2, 3, 4, 5, 6
days = days + 1
' hr=

'Need something here to calculate the time diff properly as per the
'day change.

Case Else
dt_err:
MsgBox "Error#: " _
& Err.Number _
& vbCrLf _
& "Description: " _
& Err.Description
Resume exit_func
End Select
startdate = startdate + 1
Loop

TurnaroundTime = days

exit_func:
Exit Function

End Function
===================


Sheet1("SLA Hrs") code
==================
Private Sub Worksheet_Activate()
Dim dx As Integer
Dim Cell
Dim r, lrow

With ActiveSheet
r = 4
lrow = .Range(.Cells(r, 1), .Cells(r, 1)).End(xlDown).Row
' .Range(.Cells(r, 1), .Cells(lrow, 1)).Select
' MsgBox lrow - r + 1

For Each Cell In .Range(.Cells(r, 1), .Cells(lrow, 1))
Cell = TurnaroundTime(.Cells(r, 1), .Cells(r, 2), .Cells(r,
3), .Cells(r, 4))
.Cells(r, 5).Value = Cell
.Cells(r, 5).Activate
r = r + 1
Next Cell
End With
End Sub
=======================
I tried a lot of permutations & combinations using IFs but cannot get
the correct answer...

Sheet Data Dump
==============
Start Date End Date Start Time End Time Days Hours Total
3/31/2007 4/7/2007 8:00 AM 7:00 PM
4/1/2007 4/1/2007 12:00 AM 4:00 PM
4/2/2007 4/2/2007 2:00 PM 9:00 PM
4/3/2007 4/3/2007 9:00 AM 6:00 PM
4/4/2007 4/9/2007 2:00 PM 10:00 AM
4/5/2007 4/5/2007 2:00 AM 6:00 PM
4/6/2007 4/7/2007 2:00 PM 10:00 AM


Anyone knows how to sort this out?
Regards.

 

[noname]

Please note that the Startdate & Enddate are not entered in Date-Time
format and have their columns. starttime & endtime also have their own
seperate columns.

Hi,

i am trying to calculate using VBA, the no of shift hours worked per
day.

each day hours =9 hrs.
shift starttime =9:00 am & shift endtime=6:00 pm.(total 9 hrs in a
day)

e.g:
===
I got some work on Thursday 5:00 PM and if we finish it on Friday 6:00
PM than it will be considered as 1 Day 1 hour job
thursday - 6:00 PM-5:00 PM=1hr
friday - 6:00 PM-9:00 AM=9 hrs
total=10 hrs or 1 Day 1 hour

Things to be considered while writing the code:
1 Day = (9 AM to 6:00 PM) - that's our shift timing.
*** Weekends should be excluded (for ex: if we got some work on Friday
5:00 PM) and we finishes the work on Monday 01:00PM) than this should
be considered within one day only [Friday 1 hour (06:00 PM - 05:00 PM)
+ Monday 4 hours (1:00 PM - 9:00 AM)

The total productive hours for each day should lie between 9:00
am-6:00 pm, excluding weekends(saturday & sunday).

i am able to calculate the no of days worked excluding weekends using
a do while & select case using weekday function like this:

Module1 Code
=====================
Function TurnaroundTime(startdate As Date, enddate As Date, stime As
Date, etime As Date)
On Error GoTo dt_err

Dim days, hr
Dim starttime, endtime

Set starttime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_start")
Set endtime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_end")
days = 0
hr = 0

Do While startdate <= enddate
Select Case Weekday(startdate)
Case Is = 1, 7
days = days
' hr = hr

Case Is = 2, 3, 4, 5, 6
days = days + 1
' hr=

'Need something here to calculate the time diff properly as per the
'day change.

Case Else
dt_err:
MsgBox "Error#: " _
& Err.Number _
& vbCrLf _
& "Description: " _
& Err.Description
Resume exit_func
End Select
startdate = startdate + 1
Loop

TurnaroundTime = days

exit_func:
Exit Function

End Function
===================

Sheet1("SLA Hrs") code
==================
Private Sub Worksheet_Activate()
Dim dx As Integer
Dim Cell
Dim r, lrow

With ActiveSheet
r = 4
lrow = .Range(.Cells(r, 1), .Cells(r, 1)).End(xlDown).Row
' .Range(.Cells(r, 1), .Cells(lrow, 1)).Select
' MsgBox lrow - r + 1

For Each Cell In .Range(.Cells(r, 1), .Cells(lrow, 1))
Cell = TurnaroundTime(.Cells(r, 1), .Cells(r, 2), .Cells(r,
3), .Cells(r, 4))
.Cells(r, 5).Value = Cell
.Cells(r, 5).Activate
r = r + 1
Next Cell
End With
End Sub
=======================
I tried a lot of permutations & combinations using IFs but cannot get


the correct answer...

Sheet Data Dump
==============
Start Date End Date Start Time End Time Days Hours Total
3/31/2007 4/7/2007 8:00 AM 7:00 PM
4/1/2007 4/1/2007 12:00 AM 4:00 PM
4/2/2007 4/2/2007 2:00 PM 9:00 PM
4/3/2007 4/3/2007 9:00 AM 6:00 PM
4/4/2007 4/9/2007 2:00 PM 10:00 AM
4/5/2007 4/5/2007 2:00 AM 6:00 PM
4/6/2007 4/7/2007 2:00 PM 10:00 AM

Anyone knows how to sort this out?
Regards.

 

[noname]

Hi,

Can anyone help me with this please?

regards,

Please note that the Startdate & Enddate are not entered in Date-Time
format and have their columns. starttime & endtime also have their own
seperate columns.

Hi,

i am trying to calculate using VBA, the no of shift hours worked per
day.

each day hours =9 hrs.
shift starttime =9:00 am & shift endtime=6:00 pm.(total 9 hrs in a
day)

e.g:
===
I got some work on Thursday 5:00 PM and if we finish it on Friday 6:00
PM than it will be considered as 1 Day 1 hour job
thursday - 6:00 PM-5:00 PM=1hr
friday - 6:00 PM-9:00 AM=9 hrs
total=10 hrs or 1 Day 1 hour

Things to be considered while writing the code:
1 Day = (9 AM to 6:00 PM) - that's our shift timing.
*** Weekends should be excluded (for ex: if we got some work on Friday
5:00 PM) and we finishes the work on Monday 01:00PM) than this should
be considered within one day only [Friday 1 hour (06:00 PM - 05:00 PM)
+ Monday 4 hours (1:00 PM - 9:00 AM)

The total productive hours for each day should lie between 9:00
am-6:00 pm, excluding weekends(saturday & sunday).

i am able to calculate the no of days worked excluding weekends using
a do while & select case using weekday function like this:

Module1 Code
=====================
Function TurnaroundTime(startdate As Date, enddate As Date, stime As
Date, etime As Date)
On Error GoTo dt_err

Dim days, hr
Dim starttime, endtime

Set starttime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_start")
Set endtime = ThisWorkbook.Sheets("SLA Hrs").Range("Shift_end")
days = 0
hr = 0

Do While startdate <= enddate
Select Case Weekday(startdate)
Case Is = 1, 7
days = days
' hr = hr

Case Is = 2, 3, 4, 5, 6
days = days + 1
' hr=

'Need something here to calculate the time diff properly as per the
'day change.

Case Else
dt_err:
MsgBox "Error#: " _
& Err.Number _
& vbCrLf _
& "Description: " _
& Err.Description
Resume exit_func
End Select
startdate = startdate + 1
Loop

TurnaroundTime = days

exit_func:
Exit Function

End Function
===================

Sheet1("SLA Hrs") code
==================
Private Sub Worksheet_Activate()
Dim dx As Integer
Dim Cell
Dim r, lrow

With ActiveSheet
r = 4
lrow = .Range(.Cells(r, 1), .Cells(r, 1)).End(xlDown).Row
' .Range(.Cells(r, 1), .Cells(lrow, 1)).Select
' MsgBox lrow - r + 1

For Each Cell In .Range(.Cells(r, 1), .Cells(lrow, 1))
Cell = TurnaroundTime(.Cells(r, 1), .Cells(r, 2), .Cells(r,
3), .Cells(r, 4))
.Cells(r, 5).Value = Cell
.Cells(r, 5).Activate
r = r + 1
Next Cell
End With
End Sub
=======================
I tried a lot of permutations & combinations using IFs but cannot get
the correct answer...

Sheet Data Dump
==============
Start Date End Date Start Time End Time Days Hours Total
3/31/2007 4/7/2007 8:00 AM 7:00 PM
4/1/2007 4/1/2007 12:00 AM 4:00 PM
4/2/2007 4/2/2007 2:00 PM 9:00 PM
4/3/2007 4/3/2007 9:00 AM 6:00 PM
4/4/2007 4/9/2007 2:00 PM 10:00 AM
4/5/2007 4/5/2007 2:00 AM 6:00 PM
4/6/2007 4/7/2007 2:00 PM 10:00 AM

Anyone knows how to sort this out?
Regards.

 

[Carl Hartness]

What do you intend to do with starts and ends outside the normal
shift?
3/31 8 am to 7 pm is 11 hours
4/1 12 am to 4 pm is 16 hours
4/2 2 pm to 9 pm is 7 hours
4/5 2 am to 6 pm is 16 hours

Carl

 

[Carl Hartness]

Also, 3/31, 4/1, and 4/7 are weekend days. It's hard to exclude
weekends if start or end is a weekend day. Is your example table
bogus?

 

[noname]

Nope Carl,

Done it at Last!

Here's the Complete code! Thanks to a couple of people in
googlegroups.

Option Explicit

Function HoursWorked(Date1 As Double, _
Date2 As Double, _
Time1 As Double, _
Time2 As Double) As String

Const ShiftStart As Double = 9 / 24 ' 9:00 AM
Const ShiftEnd As Double = 18 / 24 ' 6:00 PM
Const Shift As Double = ShiftEnd - ShiftStart

Dim Dat As Double
Dim Dat1 As Double
Dim Dat2 As Double
Dim Total As Double
Dim OriginalHours As Double
Dim NumericHours As Double
Dim Hours As Double
Dim Days As Double
Dim DaysHours As String

Dat1 = Date1
If Time1 = 0 Then
'no time given: default to START of Business day
Time1 = ShiftStart
Else
'adjust to time within the Business day
If Time1 < ShiftStart Then Time1 = ShiftStart
If Time1 > ShiftEnd Then Time1 = ShiftEnd
End If

Dat2 = (Date2)
If Time2 = 0 Then
'no time given: default to END of Business day
Time2 = ShiftEnd
Else
'adjust to time within the Business day
If Time2 < ShiftStart Then Time2 = ShiftStart
If Time2 > ShiftEnd Then Time2 = ShiftEnd
End If

Total = 0
If Dat2 = Dat1 Then 'Same day
If NotHoliday(Dat1) Then Total = Time2 - Time1 'Check if
Business day
Else
For Dat = Dat1 To Dat2 'Different days
If NotHoliday(Dat) Then 'Check if Working day
Select Case Dat
Case Dat1 'start date
Total = Total + (ShiftEnd - Time1)
Case Dat2 'end date
Total = Total + (Time2 - ShiftStart)
Case Else 'days between
Total = Total + Shift
End Select
End If
Next Dat
End If

OriginalHours = Total
NumericHours = OriginalHours * 24
Days = Int(NumericHours / 9)
Hours = NumericHours - Days * 9
If (Days < 0) Then ' if less than a day (-ve day)
Days = 0 ' make days = 0
Else
Days = Days ' Else Keep it the same
End If
DaysHours = Days & " Days-" & worksheetfunction.RoundUp(Hours, 0)
& " Hours"
HoursWorked = DaysHours
End Function

Private Function NotHoliday(Dt As Double) As Boolean
NotHoliday = False
If Dt Mod 7 >= 2 Then 'N.B. Sunday -> 1, Saturday -> 0
NotHoliday = True
Else
NotHoliday = False
End If
End Function

**********************************
IF the Starting date is a weekend, it will not take into consideration
the logged hours.

Cheers!