Hello,
I am looking to get some help with a VBA function that would select a shift from a table based on the current date and time. It would then write this data out to another table to be used by other items. I currently have something that works most of the time but has problems calculating the night shift correctly. Night shift spans over midnight. Below is my VBA function:
My table is as follows:
ShiftName ShiftStart ShiftEnd DaysOfTheWeek Ord
Between Shifts 4:30:01 AM 5:59:59 AM 3 4
Between Shifts 4:30:01 PM 5:59:59 PM 3 6
Between Shifts 4:30:01 AM 5:59:59 AM 4 8
Between Shifts 4:30:01 PM 5:59:59 PM 4 10
Between Shifts 4:30:01 AM 5:59:59 AM 5 12
Between Shifts 4:30:01 PM 5:59:59 PM 5 14
Between Shifts 4:30:01 AM 5:59:59 AM 6 16
Between Shifts 6:30:01 PM 12/31/1899 5:59:59 AM 6 18
Days 6:00:00 AM 4:30:00 PM 2 1
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 5 15
Weekend 6:00:00 AM 6:30:00 PM 6 17
Weekend 6:00:00 AM 6:30:00 PM 7 19
Days 6:00:00 AM 4:30:00 PM 3 5
Days 6:00:00 AM 4:30:00 PM 4 9
Days 6:00:00 AM 4:30:00 PM 5 13
Weekend 6:00:00 AM 6:30:00 PM 1 21
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 2 3
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 3 7
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 4 11
Between Shifts 6:30:01 PM 7:59:59 PM 1 22
Between Shifts 6:30:01 PM 12/31/1899 5:59:59 AM 7 20
Between Shifts 4:30:01 PM 5:59:59 PM 2 2
Nights OT 8:00:00 PM 12/31/1899 4:30:00 AM 1 23
Between Shifts 4:30:01 AM 5:59:59 AM 2 24
Day shift and Weekend shift seem to work fine but Night shift is one day more than it should be some times. Any help on this would be greatly appreciated.
Chris Morton
I am looking to get some help with a VBA function that would select a shift from a table based on the current date and time. It would then write this data out to another table to be used by other items. I currently have something that works most of the time but has problems calculating the night shift correctly. Night shift spans over midnight. Below is my VBA function:
Code:
Public Function DetermineShift() 'Determine Current Shift
Dim WD As Integer, WDP As Integer
Dim Bt As Date
10 On Error GoTo ErrorHandler
20 strSQL = "DELETE * FROM tblCurrentShift"
30 CurrentDb.Execute (strSQL)
'WD = 2
' Bt = #11:46:42 PM#
40 WD = Weekday(Date)
50 WDP = IIf(WD = 1, 7, WD - 1)
60 Bt = Time
70 strSQL = "INSERT INTO tblCurrentShift (ShiftName, ShiftStart, ShiftEnd, DaysOfTheWeek, Ord) " & _
" SELECT tblShifts.ShiftName, tblShifts.ShiftStart, tblShifts.ShiftEnd, tblShifts.DaysOfTheWeek, tblShifts.Ord " & _
" FROM tblShifts WHERE " & _
" (tblShifts.ShiftStart <= #" & Bt & "# AND tblShifts.ShiftEnd >=#" & Bt & "# AND tblShifts.DaysOfTheWeek=" & WD & ") " & _
" OR ((select min(ShiftStart) from tblshifts where daysoftheweek=" & WD & ")> # " & Bt & "# AND tblShifts.DaysOfTheWeek=" & WDP & " AND tblshifts.shiftstart=(select max(shiftstart) from tblshifts where daysoftheweek=" & WDP & "))" & _
" OR ((select max(shiftstart) from tblshifts where daysoftheweek=" & WD & ") < # " & Bt & "# AND tblShifts.DaysOfTheWeek=" & WD & " AND tblshifts.shiftstart=(select max(shiftstart) from tblshifts where daysoftheweek=" & WD & "))"
80 CurrentDb.Execute (strSQL)
Exit_ErrorHandler:
90 Exit Function
ErrorHandler:
100 Select Case Err.Number
'ODBC Call Fail Error
Case 3146
110 Call LogError(Err.Number, Err.Description, "DetermineShift", Erl, False)
120 Resume Exit_ErrorHandler
130 Case Else
140 Call LogError(Err.Number, Err.Description, "DetermineShift", Erl)
150 Resume Exit_ErrorHandler
160 End Select
End Function
ShiftName ShiftStart ShiftEnd DaysOfTheWeek Ord
Between Shifts 4:30:01 AM 5:59:59 AM 3 4
Between Shifts 4:30:01 PM 5:59:59 PM 3 6
Between Shifts 4:30:01 AM 5:59:59 AM 4 8
Between Shifts 4:30:01 PM 5:59:59 PM 4 10
Between Shifts 4:30:01 AM 5:59:59 AM 5 12
Between Shifts 4:30:01 PM 5:59:59 PM 5 14
Between Shifts 4:30:01 AM 5:59:59 AM 6 16
Between Shifts 6:30:01 PM 12/31/1899 5:59:59 AM 6 18
Days 6:00:00 AM 4:30:00 PM 2 1
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 5 15
Weekend 6:00:00 AM 6:30:00 PM 6 17
Weekend 6:00:00 AM 6:30:00 PM 7 19
Days 6:00:00 AM 4:30:00 PM 3 5
Days 6:00:00 AM 4:30:00 PM 4 9
Days 6:00:00 AM 4:30:00 PM 5 13
Weekend 6:00:00 AM 6:30:00 PM 1 21
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 2 3
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 3 7
Nights 6:00:00 PM 12/31/1899 4:30:00 AM 4 11
Between Shifts 6:30:01 PM 7:59:59 PM 1 22
Between Shifts 6:30:01 PM 12/31/1899 5:59:59 AM 7 20
Between Shifts 4:30:01 PM 5:59:59 PM 2 2
Nights OT 8:00:00 PM 12/31/1899 4:30:00 AM 1 23
Between Shifts 4:30:01 AM 5:59:59 AM 2 24
Day shift and Weekend shift seem to work fine but Night shift is one day more than it should be some times. Any help on this would be greatly appreciated.
Chris Morton