Add hours to Date Value with working hours condition (Need help on existing Macro)

[navensg]

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

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

[jzwp11]

I think the following addition shown in red below should do what you are after

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


   'check to see if the stop time is past 5pm; if it is set it to 5pm
   If TimeValue(datDateEnd) > cdatWorkTimeStop Then
    datDateEnd = DateValue(datDateEnd) + cdatWorkTimeStop
   End If
   
   'check to see if the start time is before 8am; if it is set it to 8am
   If TimeValue(datDateEnd) < cdatWorkTimeStart Then
    datDateEnd = DateValue(datDateEnd) + cdatWorkTimeStart
   End If



   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