vba code to add time difference in date & time to get next time within working days

[Ria]

Hello all VBA Gurus:

I am using EXCEL 2003. I have worksheet, column A has date and time (e.g. 31/10/2014 3:00:00 PM). Working hours are 9:30am to 4pm (Monday-Friday), every date (in next cell row) is repeated with increment of either 5 minutes or 15 minutes or 30 minutes or 1 hour or 2 or 4 hours. Then we plot graph/charts based on data. Requirements are:

1. First find time difference from cell A1 - A2, call it TIME DIFFERENCE (eg. 1 hour or 60 minutes).
2. Read last row of data (read date and time from last row in column A50 for example: 31/10/2014 3:00:00 PM), then add TIME DIFFERENCE in last date with time (example: 31/10/2014 3:00:00 PM) and put it in next cell row of column A e.g. A51: 31/10/2014 4:00:00 PM and after 4pm, move to next date/workday and start adding from 9:30am and put value in next cell: A52 e.g. 01/11/2014 10:00:00 AM (First hour is equal to 30 minutes then all next working hours are 60 minutes till 4:00pm). Repeat this process until specified in cell: F2=20. We do this for future projections to expect the completion time and date within working days. It should exclude weekend and stat holidays (in attached code there are 2 functions that are taking care of weekends and stat holidays).

Attached is my working code, works fine only for if time difference is 1 hour and messes up for 5 min/15min/30min especially when hits weekend. Now we need to consider minutes (5/15/30/60), 60min/1 hours.

If I can get it working for if time difference is a day or week whatever is time difference in above point 1, would be excellent but not really important. NOTE: if time difference is 1 week, then do not consider Weekend or Stat holidays.

Attached code, I was trying to modify but ended up burning my mind and did not get to any solution and now looking towards experts. Previous working code only for hour time difference is:

Any help would be appreciated.

Thanks

Ria

Sub FLDDateExtentionH()
  Dim FLD_Count As Integer, I As Integer, LR As Long, LRDate As Date
  Application.ScreenUpdating = False
  FLD_Count = ActiveSheet.Range("F2").Value
  LR = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
  LRDate = ActiveSheet.Range("A" & LR).Value
  ' Begin the loop.  For I = 1 To FLD_Count
  If (Hour(LRDate) = 16) Then
  Do
  LRDate = Int(LRDate) + 1
  Loop While IsHoliday(LRDate) Or IsWeekEnd(LRDate)
  ActiveSheet.Range("A" & LR + I).Value = LRDate + (10 / 24)
  Else
  ActiveSheet.Range("A" & LR + I).Value = LRDate + (1 / 24)
  End If
  LRDate = ActiveSheet.Range("A" & LR + I).Value
  Next I
  Application.ScreenUpdating = True
End Sub

Private Function IsHoliday(ByVal myDate) As Boolean
  '''Holiday Table should include stat holiday  Dim arr, intLoop As Integer
  arr = Worksheets("Holidays").Range("a1:a5000")
  IsHoliday = False
  For intLoop = 1 To UBound(arr)
  If arr(intLoop, 1) = "" Then Exit For
  If arr(intLoop, 1) = myDate Then IsHoliday = True: Exit For
  Next
End Function
Private Function IsWeekEnd(ByVal myDate) As Boolean
  Dim intWeekDay
  IsWeekEnd = True
  intWeekDay = myDate Mod 7
  If intWeekDay > 1 Then
  IsWeekEnd = False
  End If
End Function