Get enddatetime if X no. of working hours is added to startdatetime

[againofsoul]

Hi I am facing difficult in getting the correct enddate time.
Please refer to below vba. Those in Red are populating the wrong enddatetime. Can help to check my vba function?


This are the criteria:

1: Working hours for Weekday 8.30 am to 5.30 pm excluding lunch break from 12 pm to 1 pm
2: Working hours for Weekends / PH is from 8.30 am to 12.30 pm (no lunch)

My intention is to get the enddatetime if X no. of working hours is added to the startdatetime.

Function AddWorkingHours(startDate As Date, hoursToAdd As Integer) As Date
Dim currentDateTime As Date
Dim hoursRemaining As Integer
Dim lunchStart As Date
Dim lunchEnd As Date
Dim publicHolidays As Collection
Dim holiday As Variant


' Check if the current date is a public holiday
Dim isHoliday As Boolean
isHoliday = False



' Define public holidays
Set publicHolidays = New Collection
publicHolidays.Add DateSerial(2024, 1, 1) ' 01-Jan-2024
publicHolidays.Add DateSerial(2024, 2, 11) ' 11-Feb-2024
publicHolidays.Add DateSerial(2024, 2, 12) ' 12-Feb-2024
publicHolidays.Add DateSerial(2024, 3, 29) ' 29-Mar-2024
publicHolidays.Add DateSerial(2024, 4, 10) ' 10-Apr-2024
publicHolidays.Add DateSerial(2024, 5, 1) ' 01-May-2024
publicHolidays.Add DateSerial(2024, 5, 22) ' 22-May-2024
publicHolidays.Add DateSerial(2024, 6, 17) ' 17-Jun-2024
publicHolidays.Add DateSerial(2024, 8, 9) ' 09-Aug-2024
publicHolidays.Add DateSerial(2024, 10, 31) ' 31-Oct-2024
publicHolidays.Add DateSerial(2024, 12, 25) ' 25-Dec-2024



For Each holiday In publicHolidays
If DateValue(currentDateTime) = holiday Then
isHoliday = True
Exit For
End If
Next holiday




If startDate = isHoliday Or Weekday(startDate, vbMonday) > 5 Then
If TimeValue(startDate) > TimeValue("12:30:00") Then
startDate = DateValue(startDate) + TimeValue("12:30:00")
End If
End If


If startDate = isHoliday Or Weekday(startDate, vbMonday) > 5 Then
If TimeValue(startDate) < TimeValue("8:30:00") Then
startDate = DateValue(startDate) + TimeValue("8:30:00")
End If
End If


If startDate <> isHoliday And Weekday(startDate, vbMonday) < 6 Then
If TimeValue(startDate) < TimeValue("8:30:00") Then
startDate = DateValue(startDate) + TimeValue("8:30:00")
End If
End If


If startDate <> isHoliday And Weekday(startDate, vbMonday) < 6 Then
If TimeValue(startDate) < TimeValue("13:00:00") And TimeValue(startDate) > TimeValue("11:59:59") Then
startDate = DateValue(startDate) + TimeValue("13:00:00")
End If
End If

If startDate <> isHoliday And Weekday(startDate, vbMonday) < 6 Then
If TimeValue(startDate) > TimeValue("17:30:00") Then
startDate = DateValue(startDate) + TimeValue("17:30:00")
End If
End If








currentDateTime = startDate
hoursRemaining = hoursToAdd



Do While hoursRemaining > 0
' Define lunch break times
lunchStart = TimeSerial(12, 0, 0)
lunchEnd = TimeSerial(13, 0, 0)




' Add one hour to the current datetime
currentDateTime = currentDateTime + TimeValue("01:00:00")



If currentDateTime = isHoliday Then
If Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12.5 Then
' Decrease the remaining hours to add
hoursRemaining = hoursRemaining - 1
End If




ElseIf Weekday(currentDateTime, vbMonday) < 6 And Not isHoliday Then ' Regular weekday
If (Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12) Or (Hour(currentDateTime) >= 13 And Hour(currentDateTime) < 17.5) Then
' Exclude lunch break
hoursRemaining = hoursRemaining - 1

End If




ElseIf Weekday(currentDateTime, vbMonday) > 5 And Not isHoliday Then
If Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12.5 Then
' Decrease the remaining hours to add
hoursRemaining = hoursRemaining - 1
End If
End If





Loop



If Hour(currentDateTime) = 13 And Minute(currentDateTime) = 0 Then
currentDateTime = DateValue(currentDateTime) + TimeValue("12:00:00")
End If







' Return the final datetime
AddWorkingHours = currentDateTime


End Function

 

[myall_blues]

If you look at your first example: 11/5/2024 starting at 08:50 then because it's a Saturday you've got 3 hours and 40 minutes available from the start time until 12:30, leaving you with 20 minutes.
This part of your code only deals in whole hours and also is a Do While hours remaining >0.

    Do While hoursRemaining > 0
        ' Define lunch break times
        lunchStart = TimeSerial(12, 0, 0)
        lunchEnd = TimeSerial(13, 0, 0)
        ' Add one hour to the current datetime
        currentDateTime = currentDateTime + TimeValue("01:00:00")
        If currentDateTime = isHoliday Then
            If Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12.5 Then
            ' Decrease the remaining hours to add
            hoursRemaining = hoursRemaining - 1
            End If
        ElseIf Weekday(currentDateTime, vbMonday) < 6 And Not isHoliday Then ' Regular weekday
            If (Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12) Or _
                (Hour(currentDateTime) >= 13 And Hour(currentDateTime) < 17.5) Then
                ' Exclude lunch break
                hoursRemaining = hoursRemaining - 1
            End If
        ElseIf Weekday(currentDateTime, vbMonday) > 5 And Not isHoliday Then
            If Hour(currentDateTime) >= 8.5 And Hour(currentDateTime) < 12.5 Then
                ' Decrease the remaining hours to add
                hoursRemaining = hoursRemaining - 1
            End If
        End If
    Loop

As a result on the second last loop the hours remaining is >0 so it adds a whole hour by the line

        ' Add one hour to the current datetime
        currentDateTime = currentDateTime + TimeValue("01:00:00")

but never removes it because none of the subsequent If clauses are then true, so you end up with 12:50.

I think your better off adding the whole time up front and then dealing with the consequences of going over date/time limits. I commented out all the lines shown above and added this instead

    currentDateTime = startDate            ' This is your existing code
    hoursRemaining = hoursToAdd        ' This is your existing code
    currentDateTime = currentDateTime + hoursToAdd / 24
    If currentDateTime = isHoliday Or Weekday(currentDateTime, vbMonday) > 5 Then
            If (Hour(currentDateTime) + Minute(currentDateTime) / 60) > 12.5 Then
                currentDateTime = currentDateTime + 20 / 24
            End If
    End If

That gives the result 12/5/2024 08:50 AM which I think is correct? I didn't fix any of the other cases or check what happens to the existing ones (at least partly because date/time stuff is definitely not my thing ) but hopefully you can proceed from here. Respond back if you need more help.