VBA help - Locking & unlocking on certain times of day

A

Anthony86

Board Regular
Joined
Jan 31, 2018
Messages
70
Office Version
  1. 365
Platform
  1. Windows
Hi,

Can anyone shed some light on why this code isn't working. This is code from another site and some that had been sent to me.

What I'm after is some code that locks the worksheets depending on time off day. I currently have a day/night shift and I need only their cells open when they are on shift. The code seems to loop with the timers that are set.

VBA Code: 
Private Sub Workbook_Open()
Dim CurrTime As Date
Dim LockTime As Date
Dim UnLockTime As Date

CurrTime = Time ' Get the Current Time
LockTime = TimeValue("06:05:00") ' Specify the Lock Time
UnLockTime = TimeValue("18:00:00") ' Specify the Unlock Time

     If CurrTime > UnLockTime Then ' If the sheet is opened later than the specified unlock time then we want make sure the cells are unlocked.

            Application.Run "LockSheet"

     Else

        If CurrTime < LockTime Then ' Check to see if the sheet is opened before the lock time

            ' When the sheet is open, before the LockTime, we need to make sure the cells are unlocked
            Application.Run "LockSheet"

            ' Then we can set a timer to run to lock the cells at the defined time.
            Application.OnTime UnLockTime - CurrTime + Now, "UnLockSheet"

            Else

                ' This will automaticly Lock the cells if opened after the Lock time but before the unlock time
                Application.Run "UnLockSheet"

                ' If opened after the Lock time but before the unlock time, the timer will need to start, ready to unlock the cells at the specified time
                Application.OnTime LockTime - CurrTime + Now, "LockSheet"

        End If

     End If

   
End Sub

VBA Code: 
Sub LockSheet()
    
    Application.ScreenUpdating = False

    ' This will lock the cells

    ' Specify the exact sheet name otherwise whichever sheet is active, will have cells unlocked and a password set
    ' I would also specify the workbook name to prevent any other workbook cell being locked and sheets being password protected

    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A1:Y5").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A7:Y7").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Protect Password:="Password"
    
    
    MsgBox "Day cells have been locked / Nights unlocked"
    
    
    
    ' Now the timer has to be reset to unlock the cells
    Dim CurrTime As Date
    Dim UnLockTime As Date

    CurrTime = Time
    UnLockTime = TimeValue("18:00:00")
    Application.OnTime UnLockTime - CurrTime + Now, "UnLockSheet"

    Application.Run "NightUnLock"
    Application.ScreenUpdating = True
    

End Sub

VBA Code: 
Sub NightUnLock()

Select Case weekday(Date, vbSunday)
  Case 1 'Sunday
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Protect Password:="Password"
  Case 2 ' Monday
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Protect Password:="Password"
  Case 3  'Tuesday
   Workbooks("Test - Copy.xlsm").Worksheets("Tues").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Protect Password:="Password"
  Case 4  'Wednesday
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Protect Password:="Password"
  Case 5  'Thursday
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Protect Password:="Password"
  Case 6  'Friday
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Protect Password:="Password"
  Case 7  'Saturday
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A6:Y6").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A8:Y8").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Protect Password:="Password"
    
    ThisWorkbook.Save
  End Select
  
End Sub


VBA Code: 
Sub UnLockSheet()

    Application.ScreenUpdating = False

    ' This will unlock the cells

    ' Specify the exact sheet name otherwise whichever sheet is active, will have cells unlocked and a password set
    ' I would also specify the workbook name to prevent any other workbook cells being unlocked and sheets being password protected
    Select Case weekday(Date, vbSunday)
  Case 1 'Sunday
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Protect Password:="Password"
  Case 2 ' Monday
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Protect Password:="Password"
  Case 3  'Tuesday
   Workbooks("Test - Copy.xlsm").Worksheets("Tues").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Protect Password:="Password"
  Case 4  'Wednesday
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Protect Password:="Password"
  Case 5  'Thursday
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Protect Password:="Password"
  Case 6  'Friday
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Protect Password:="Password"
  Case 7  'Saturday
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A1:Y5").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A7:Y7").Locked = False
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Protect Password:="Password"
    
  End Select
  Application.Run "NightLock"
  
  ThisWorkbook.Save

    MsgBox "Days have been unlocked / Nights Locked"
    
End Sub


VBA Code: 
Sub NightLock()
 
  
    'Nights Lock
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sun").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Mon").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Tues").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Weds").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Thurs").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Fri").Protect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Unprotect Password:="Password"
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A6:Y6").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Range("A8:Y8").Locked = True
    Workbooks("Test - Copy.xlsm").Worksheets("Sat").Protect Password:="Password"

End Sub
 
Sort by date Sort by votes
Hi Dave,

Spoke to soon :) Was working in the spreadsheet during the night and I may have overlooked this part. So come midnight, Tuesday night shift locked and Wednesday night unlocked. I need Tuesday night to stay unlocked till the day shift starts.

Is that possible
 
Upvote 0

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
Anthony86 said:
come midnight, Tuesday night shift locked and Wednesday night unlocked. I need Tuesday night to stay unlocked till the day shift starts.
Click to expand...

Hi
I did state when I first posted that its been many years since I had done anything with the OnTime method & now you mention it, seem to recall running in to similar issue when working across a 24 hr timespan.
I will when have a moment try & have a look at the issue or perhaps another here will kindly point out the blindingly obvious part I missed.

Dave
 
Upvote 0
Had a very short play by setting my system time to 23:59 & locked status for Wed night shift did not change.

I can only guess that you may have another timer running?

Try this updated code & see if works for you

VBA Code: 
Sub SetShift(Optional ByVal WhatShift As XLWorkShift)
    Dim wb              As Workbook
    Dim i               As Long
    Dim StartShift      As Boolean
    Dim DayShift        As Variant, NightShift As Variant, WhichShift   As Variant
    Dim NightShiftStart As Date, DayShiftStart As Date, CurrTime        As Date
   
    On Error GoTo myerror
    '-------------------------------------------------------------------------------------------------
    '                               Ver 2 Nov 2024
    '-------------------------------------------------------------------------------------------------
    'set object variable to workbook
   
    'not sure if your code resides in the same workbook it applies to or if you are refering to another?
    'if applies to another workbook then use this line ensuring that you have to correct name entered
    'Set wb = Workbooks("Test - Copy.xlsm")
   
    'but if code resides in the workbook it applies to then just use this line
    Set wb = ThisWorkbook
    '------------------------------------------------------------------------------------------------
    '------------------------------------------------------------------------------------------------
    'initialize shift time variables
    CurrTime = Time  'system time
    NightShiftStart = TimeValue("18:00:00")
    DayShiftStart = TimeValue("06:05:00")
    '------------------------------------------------------------------------------------------------
   
    'unlikely to occur but just in case - add 5 seconds to ensure night shift timer applied
    'If CurrTime = NightShiftStart Then CurrTime = CurrTime + (5 / 86400)
   
    'intialize shift variables
    NightShift = "'LockSheet """ & xlNightShift & """,""" & wb.Name & """ '"
    DayShift = "'LockSheet """ & xlDayShift & """,""" & wb.Name & """ '"
    LockCells = "'LockSheet """ & xlLockCells & """,""" & wb.Name & """ '"
   
    StartShift = WhatShift = xlStartShift
   
    'apply shift timer
    If WhatShift <> xlCancelShifts Then
       
        Select Case CurrTime
            Case DayShiftStart To NightShiftStart
                'day shift - set nightshift timer
               If Not StartShift Then Application.OnTime EarliestTime:=NightShiftStart, Procedure:=NightShift
                WhichShift = DayShift
            Case Else
                'night shift - set dayshift timer
                If Not StartShift Then Application.OnTime EarliestTime:=DayShiftStart, Procedure:=DayShift
                WhichShift = NightShift
        End Select
        'when workbook first opened, unlock appropriate shift ranges in each weekday sheet
        If StartShift Then Application.Run WhichShift
       
    Else
        'cancel timers
        On Error Resume Next
        For i = 1 To 2
            Application.OnTime EarliestTime:=Choose(i, NightShiftStart, DayShiftStart), _
                               Procedure:=Choose(i, NightShift, DayShift), Schedule:=False
        Next i
        On Error GoTo myerror
        'lock all cells in range before saving
        Application.Run LockCells
    End If
   
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave
 
Upvote 0
Hi Dave,

The change didn't work. Just after midnight he opened the workbook and it locked previous day night shift and unlocked current day nights.

From Midnight till 0600 I'll need the previous day night shift still unlocked, then from 06:05, current day day unlocked.
 
Upvote 0
Anthony86 said:
Hi Dave,

The change didn't work. Just after midnight he opened the workbook and it locked previous day night shift and unlocked current day nights.

From Midnight till 0600 I'll need the previous day night shift still unlocked, then from 06:05, current day day unlocked.
Click to expand...

ok will have a look when get a moment

Dave
 
Upvote 0
Hi
I have only lightly tested but see if these updates to the codes resolve your issue

These codes REPLACE both existing codes In module named LockSheet_Code
VBA Code: 
Enum XLWorkShift
    xlDayShift = 1
    xlNightShift
    xlStartShift
    xlMidnightShift
    xlCancelShifts
    xlLockCells
End Enum

Sub LockSheet(ByVal Whatshift As XLWorkShift, ByVal wb As String)
    Dim DayOfWeek               As Variant
    Dim ws                      As Worksheet
    Dim UnlockSundayShifts      As Boolean, ClearNextDay        As Boolean
    Dim LockDayShift            As Boolean, LockNightShift      As Boolean
    Dim LockAllCells            As Boolean
    Dim TodaySheet              As String, NextDaySheet         As String
    Dim WeekDayNum              As Long
    Dim ShiftDate               As Date
   
    Const strPassword As String = "Password"
   
    '-------------------------------------------------------------------------------------------------
    '                               Ver 4 Nov 2024
    '-------------------------------------------------------------------------------------------------
   
    'shift date (if start after midnight shift day date is for previous day
    ShiftDate = IIf(Whatshift = xlMidnightShift, Date - 1, Date)
   
    'day of week array
    DayOfWeek = Application.GetCustomListContents(xlDay)
   
    'day of week (monday = 1)
    WeekDayNum = Weekday(ShiftDate, vbMonday)
   
    'variable for todays sheet
    TodaySheet = DayOfWeek(WeekDayNum)
    'for next day, change sunday(7) to monday(1)
    WeekDayNum = IIf(WeekDayNum = 7, 1, WeekDayNum + 1)
    'variable for nextday sheet
    NextDaySheet = DayOfWeek(WeekDayNum)
   
    'lock which cells
    LockAllCells = Whatshift = xlLockCells
    LockDayShift = Whatshift = xlNightShift Or Whatshift = xlMidnightShift Or LockAllCells
    LockNightShift = Whatshift = xlDayShift Or LockAllCells
   
    Application.ScreenUpdating = False
   
    'loop all weekday sheets & apply locked status
    For Each ws In Workbooks(wb).Worksheets(DayOfWeek)
        With ws
            .Unprotect strPassword
            UnlockSundayShifts = ws.Name = DayOfWeek(7) And Not LockAllCells
            ClearNextDay = ws.Name = NextDaySheet And WeekDayNum < 6
            If ClearNextDay Then .Range("B5:Y8").ClearContents
            .Range("A1:Y5,A7:Y7").Locked = IIf(UnlockSundayShifts, False, LockDayShift Or ws.Name <> TodaySheet)
            .Range("A6:Y6,A8:Y8").Locked = IIf(UnlockSundayShifts, False, LockNightShift Or ws.Name <> TodaySheet)
            .Protect strPassword
        End With
    Next ws
   
    If Not LockAllCells Then
        'activate today's sheet
        Worksheets(TodaySheet).Activate
        Application.ScreenUpdating = True
        'inform user
        MsgBox IIf(Whatshift = xlDayShift, "Day", "Night") & " Cells For " & TodaySheet & " have been unlocked", 64, "Information"
        're-set timer
        SetShift
    Else
        'activate sheet 1 & save
        Worksheets(1).Activate
        Application.DisplayAlerts = False
        Workbooks(wb).Save
        Application.DisplayAlerts = True
    End If
   
End Sub

This code REPLACES existing code In module named SetShift_Code
VBA Code: 
Sub SetShift(Optional ByVal Whatshift As XLWorkShift)
    Dim wb              As Workbook
    Dim i               As Long
    Dim StartShift      As Boolean
    Dim DayShift        As Variant, NightShift As Variant, MidnightShift    As Variant, WhichShift  As Variant
    Dim NightShiftStart As Date, DayShiftStart As Date, MidnightShiftStart  As Date, CurrTime       As Date
   
    On Error GoTo myerror
    '-------------------------------------------------------------------------------------------------
    '                                   Ver 4 Nov 2024
    '-------------------------------------------------------------------------------------------------
    'set object variable to workbook
   
    'not sure if your code resides in the same workbook it applies to or if you are refering to another?
    'if applies to another workbook then use this line ensuring that you have to correct name entered
    'Set wb = Workbooks("Test - Copy.xlsm")
   
    'but if code resides in the workbook it applies to then just use this line
    Set wb = ThisWorkbook
    '------------------------------------------------------------------------------------------------
    '                                   Shift Times
    '------------------------------------------------------------------------------------------------
    'initialize shift time variables
    CurrTime = Time  'system time
    NightShiftStart = TimeValue("18:00:00")
    MidnightShiftStart = TimeValue("00:00:00")
    DayShiftStart = TimeValue("06:05:00")
    '------------------------------------------------------------------------------------------------
   
    'intialize shift variables
    NightShift = "'LockSheet """ & xlNightShift & """,""" & wb.Name & """ '"
    MidnightShift = "'LockSheet """ & xlMidnightShift & """,""" & wb.Name & """ '"
    DayShift = "'LockSheet """ & xlDayShift & """,""" & wb.Name & """ '"
    LockCells = "'LockSheet """ & xlLockCells & """,""" & wb.Name & """ '"
   
    'workbook first opened
    StartShift = Whatshift = xlStartShift
   
    'apply shift timer
    If Whatshift <> xlCancelShifts Then
       
        Select Case CurrTime
            Case DayShiftStart To NightShiftStart
                'day shift - set nightshift timer
               If Not StartShift Then Application.OnTime EarliestTime:=NightShiftStart, Procedure:=NightShift
                WhichShift = DayShift
            Case MidnightShiftStart To DayShiftStart
                'midnight shift - set dayshift timer
                If Not StartShift Then Application.OnTime EarliestTime:=DayShiftStart, Procedure:=DayShift
                WhichShift = MidnightShift
            Case Else
                'night shift - set dayshift timer
                If Not StartShift Then Application.OnTime EarliestTime:=DayShiftStart, Procedure:=DayShift
                WhichShift = NightShift
        End Select
        'when workbook first opened, unlock appropriate shift ranges in each weekday sheet
        If StartShift Then Application.Run WhichShift
       
    Else
        'cancel timers
        On Error Resume Next
        For i = 1 To 2
            Application.OnTime EarliestTime:=Choose(i, NightShiftStart, DayShiftStart), _
                               Procedure:=Choose(i, NightShift, DayShift), Schedule:=False
        Next i
        On Error GoTo myerror
        'lock all cells in range before saving
        Application.Run LockCells
    End If
   
myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave
 
Upvote 0
Hey Dave,

So far all is working exceptionally well!! I'm just letting it run through the week to see if anything unexpected pops up but so far nothing :) Again, really appreciate all your time and effort on this
 
Upvote 0
Anthony86 said:
Hey Dave,

So far all is working exceptionally well!! I'm just letting it run through the week to see if anything unexpected pops up but so far nothing :) Again, really appreciate all your time and effort on this
Click to expand...

Hi
Hopefully, all is now resolved & appreciate your feedback

Dave
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question Question
VBA - Run time error '9': subscript out of range
Replies
3
Views
269
RoryA
RoryA
N
  • Question Question
VBA - Intersect code being re-initiated
Replies
1
Views
226
Peter_SSs
Peter_SSs
J
  • Question Question
Assistance changing VBA code to display as HTML or picture of a selection in Lotus Notes
Replies
2
Views
238
jularobert
J
N
  • Question Question
Locking a row after info entered
Replies
1
Views
784
RustamMika
R
G
  • Question Question
Workbook formulas copied with Sheet references in new Workbook
Replies
0
Views
406
GK039
G

Forum statistics

Threads
1,224,804
Messages
6,181,059
Members
453,016
Latest member
cherryfalling

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top