Want to Check for a GivenDate(GivenTime "Condition" RuleTime) in Excel VBA

Question

I'm working for a payroll system for my client and they have multiple business rules.

There are weekday, saturday, sunday/Hoilday rules applicable. Day shift starts at 06:00 and ends at 22:59 for a given date. Night shift starts from 23:00 of present date and ends at 05:59 of next day morning.

Say a employee starts working at 22:00 on Friday and ends his work on 10:00 at Saturday. For this given example,

employee works 00:59 hours in Friday - Day shift which is from 22:00 to 22:59
Employee works 6:59 hours in Friday - Night shift which is from 23:00(friday) to 5:59(saturday)
Employee works 04:00 hours in Saturday - Day shift which is from 06:00 to 10:00

I want to split this time as Weekday - DayTime and NightTime and also Saturday - DayTime

I'm working on VBA code to find logic for this.

MyCode:

StartDateReturnValue = Weekday(startDate, vbSunday)
endDateReturnValue = Weekday(endDate, vbSunday)

'Same Day: Start time and End time is NIGHTTIME
If endDateReturnValue = StartDateReturnValue + 1 And TimeValue(startTime) >= TimeValue("23:00:00") And TimeValue(endTime) <= TimeValue("05:59:00") Then

I want something like this to be very specific

StartWorkday(Timevalue(startTime)>=TimeValue("22:59:00")) And EndWorkday(Timevalue(endTime)<=TimeValue("05:59:00"))

Nicholas Stom Nicholas Stom · Accepted Answer · 2020-11-28T22:47:07

This should work. This is my brute force method to solve the problem. Long term I would make this more elegant/efficient/minimize iteration of the while loop.


Sub Test()

    PayRoleTime "11/27/2020  10:00:00 PM", "11/28/2020 10:00:00 AM"

End Sub

Public Function PayRoleTime(startTime As Date, endTime As Date)
'Declare Variables
    Dim startDbl, startHour, startMin, startHourMin As Double
    Dim endDbl, endHour, endMin, endHourMin As Double
    Dim currentDbl, currentHour, currentMin, currentHourMin As Double
    Dim workWeekDay(1) As Double
    Dim nightShift(1) As Double
    Dim startingDay As Double
    Dim output As Variant
    Dim currentWeekday As Integer
    
'Set Variables for Company Shift Structure
    workWeekDay(0) = 2
    workWeekDay(1) = 6
    nightShift(0) = 23
    nightShift(1) = 6
    ReDim output(5)

'Set Variables from Inputs
    startDbl = CDbl(startTime) + 0.00000033
    startingDay = Int(startDbl)
    startDay = weekDay(startingDay)
    startHour = (startDbl - Int(startDbl)) * 24
    startMin = Int((startHour - Int(startHour)) * 60)
    startHour = Int((startDbl - Int(startDbl)) * 24)
    startHourMin = startHour + (startMin / 100)
    
    endDbl = CDbl(endTime) + 0.00000033
    endingDay = Int(endDbl)
    endDay = weekDay(endingDay)
    endHour = (endDbl - Int(endDbl)) * 24
    endMin = Int((endHour - Int(endHour)) * 60)
    endHour = Int((endDbl - Int(endDbl)) * 24)
    endHourMin = endHour + (endMin / 100)
    
    currentDbl = startingDay
    currentHour = startHour
    currentMin = startMin
    currentHourMin = startHourMin
'Loop to get working hour times
    Do While (currentDbl < endingDay Or currentHour < endHour Or currentMin < endMin)
            currentWeekday = weekDay(currentDbl)
            currentHourMin = currentHour + (currentMin / 100)
            
        If currentWeekday >= workWeekDay(0) And currentWeekday <= workWeekDay(1) Then
            If currentHourMin >= nightShift(0) Or currentHourMin < nightShift(1) Then
                If currentWeekday = workWeekDay(0) And currentHourMin < nightShift(1) Then
                    output(5) = output(5) + 1 'Increment Sunday Night Shift
                Else
                    output(1) = output(1) + 1 'Increment Weekday Night Shift
                End If
            Else
                output(0) = output(0) + 1 'Increment Weekday Day Shift
            End If
        ElseIf currentWeekday < workWeekDay(0) Then
            If currentHourMin >= nightShift(0) Or currentHourMin < nightShift(1) Then
                If currentWeekday < workWeekDay(0) And currentHourMin < nightShift(1) Then
                    output(3) = output(3) + 1 'Increment Saturday Night Shift
                Else
                    output(5) = output(5) + 1 'Increment Sunday Night Shift
                End If
            Else
                output(4) = output(4) + 1 'Increment Sunday Day Shift
            End If
        ElseIf currentWeekday > workWeekDay(1) Then
            If currentHourMin > nightShift(0) Or currentHourMin < nightShift(1) Then
                If currentWeekday > workWeekDay(1) And currentHourMin < nightShift(1) Then
                    output(1) = output(1) + 1 'Increment Weekday Night Shift
                Else
                    output(3) = output(3) + 1 'Increment Saturday Night Shift
                End If
            Else
                output(2) = output(2) + 1 'Increment Saturday Day Shift
            End If
        End If

        'Increment Time
            currentMin = currentMin + 1
            If currentMin = 60 Then
                currentMin = 0
                currentHour = currentHour + 1
            End If
            If currentHour = 24 Then
                currentHour = 0
                currentDbl = currentDbl + 1
            End If

    Loop
    
   
    
'Print Results to Immediate Window
    Debug.Print "Employee worked " & output(0) / 60 & " Hours, Weekday Day Shift"
    Debug.Print "Employee worked " & output(1) / 60 & " Hours, Weekday Night Shift"
    Debug.Print "Employee worked " & output(2) / 60 & " Hours, Saturday Day Shift"
    Debug.Print "Employee worked " & output(3) / 60 & " Hours, Saturday Night Shift"
    Debug.Print "Employee worked " & output(4) / 60 & " Hours, Sunday Day Shift"
    Debug.Print "Employee worked " & output(5) / 60 & " Hours, Sunday Night Shift"
End Function

Want to Check for a GivenDate(GivenTime "Condition" RuleTime) in Excel VBA

1 Answers