• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

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

R

Ria

Member
Hello vba/excel gurus out there:

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 10am to 4pm (Monday-Friday), every date is repeated with increment of one hour. Then we plot graph/charts based on data.
What I want is 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 one hour and put it in next cell of column A e.g. A51: 31/10/2014 4:00:00 PM and after 4pm, turn to next date/workday and start adding from 9am and put value in next cell: A52 e.g. 01/11/2014 10:00:00 AM. 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.
Here I have function, that just does job without time and only considering dates but I am unable to make it work with time. Any help would be appreciated.
Code: 
Sub FLDDateExtentionH()  '**FLD HOURLY**
  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
   ActiveSheet.Range("A" & LR + I) = Workday(LRDate, I, Worksheets("Holidays").Range("A1:A5000) 'EXCLUDES WEEKEND & HOLIDAYS
  Next I
   Application.ScreenUpdating = True
End Sub

Thanks

Ria
 
Don't need a complicated macro, the formula to calculate our hours is:
=IF(HOUR(A2)=16,17/24,1/24)+A2

Copy down as far as needed. The 17 represents # of non-working hours (from 4pm to 9 am is 17 hours). The 16 represents end of workday (4 pm = 16th hour). So, formulas checks if above cell is at 4 pm, add 17 hours, else add 1 hour.
 
  • Like
Reactions: Ria
Luke M said:
Don't need a complicated macro, the formula to calculate our hours is:
=IF(HOUR(A2)=16,17/24,1/24)+A2

Copy down as far as needed. The 17 represents # of non-working hours (from 4pm to 9 am is 17 hours). The 16 represents end of workday (4 pm = 16th hour). So, formulas checks if above cell is at 4 pm, add 17 hours, else add 1 hour.
Click to expand...
Thanks Luke.
It gave me direction how to look/consider for this problem. Your solution is simple and easy to implement but we want users to stay away from any addition entries and it has to be handled through macro. But you put me on right direction and I was able to handle it with macro (it does not consider weekend/stat holidays and I can live with that). Macro did work well few hours but when we close file it shows message cross reference etc. Then try to open file and it always go to sleep (not responding) then need to kill program. Now I do not know how to get to vba to disable this macro.
Thanks again for right direction.

Ria
 
Luke M said:
Don't need a complicated macro, the formula to calculate our hours is:
=IF(HOUR(A2)=16,17/24,1/24)+A2

Copy down as far as needed. The 17 represents # of non-working hours (from 4pm to 9 am is 17 hours). The 16 represents end of workday (4 pm = 16th hour). So, formulas checks if above cell is at 4 pm, add 17 hours, else add 1 hour.
Click to expand...
Hi Luke:
Here is what I came up with solution using your provided logic. In begning it was giving message invalid reference and excel was freezing but now it is working and I do not know more than that if any mistake in my formula. It does not consider weekend and stat holidays.
Code: 
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
  ActiveSheet.Range("A" & LR + I).Value = LRDate + (18 / 24)
  Worksheets("Holidays").Range("A1:A5000"))
  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

Thanks again for direction.

Ria
 
Code: 
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
 
  • Like
Reactions: Ria
wudixin96 said:
Code: 
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
Click to expand...

Thanks wudixin96, taking time.
I am not sure how to use these 2 functions and where to call them. Any guide please.

Thanks

Ria
 
Great thanks wudixin96.
Solution you provided with code working like charm.
Again big thanks.

Ria
 
wudixin96 said:
Code: 
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
Click to expand...
======================
Hi wudixin96 and all other fellows expert in vba.

While ago, you solved one of my vba problem, no scope of the problem has been widened/increased. Here is the problem statement:

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 10am to 4pm (Monday-Friday), every date is repeated with increment of one hour. Then we plot graph/charts based on data.

1. find time difference from cell A1 - A2, call it TIME DIFFERENCE.
2. What I want is 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 last date with time (example: 31/10/2014 3:00:00 PM) and put it in next cell 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 9am and put value in next cell: A52 e.g. 01/11/2014 10:00:00 AM. 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.

Last solution provided by wudixin96, worked fine till now but it works if time difference is one hour. now we need to consider minutes, hours, day, and week whatever is time difference in above point 1.
NOTE: if time difference is 1 week, then do not consider Weekend or Stat holidays.
Any help would be appreciated.
Previous working code only for hour time difference is:
Code: 
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
 
You must log in or register to reply here.
Back
Top