Hello all,
Need help on the existing macro, The below will add hours to particular datevalue with working hours
ex: 7/18/2012 10:41 If you add 2 (means 2 hours) It will return 7/18/2012 12:41
But the problem with this Macro:
If Start Date is out side working hours like 7/20/2012 17:12 its giving 7/23/2012 10:12:00 AM, ideally it should give 7/23/2012 10:00:00 AM
The same way if it is 7/19/2012 7:59 its giving 7/19/2012 10:59 it should give 7/19/2012 10:00
Here is some sample data:
Opened |
7/18/2012 10:41 |
7/13/2012 8:48 |
7/20/2012 16:26 |
7/20/2012 17:12 |
7/3/2012 13:50 |
7/16/2012 15:36 |
7/18/2012 12:00 |
6/29/2012 13:29 |
7/19/2012 7:59 |
Code:
Public Function WorkhourAdd( _
ByVal datDateStart As Date, _
ByVal intHours As Integer) _
As Date
' Purpose: Add number of working hours to date datDateStart.
' Assumes: 5 working days per week. Adjust cbytWorkdaysOfWeek for other values.
' First workday is Monday.
' Weekend is up to and including Sunday.
' Specify begin and end time of daily working hours.
Const cdatWorkTimeStart As Date = #8:00:00 AM#
Const cdatWorkTimeStop As Date = #5:00:00 PM#
Const cbytWorkdaysOfWeek As Byte = 5
Dim intCount As Integer
Dim datDateEnd As Date
datDateEnd = datDateStart
While intCount < intHours
datDateEnd = DateAdd("h", 1, datDateEnd)
If Weekday(datDateEnd, vbMonday) <= cbytWorkdaysOfWeek Then
If DateDiff("h", cdatWorkTimeStart, TimeValue(datDateEnd)) > 0 Then
If DateDiff("h", TimeValue(datDateEnd), cdatWorkTimeStop) >= 0 Then
intCount = intCount + 1
End If
End If
End If
Wend
WorkhourAdd = datDateEnd
End Function
Thanks in Advance,
Naveen