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
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Sort by date Sort by votes
Hi

It’s been many years since I have done anything that uses OnTime function but found a quiet moment to have a look at what I think you are trying to do & hopefully what I have come up with will go in right direction -maybe

Please follow directions carefully

1 – Make a BACK-UP of your workbook & then DELETE ALL existing code

2 – Place Following Codes in STANDARD modules as directed

These codes In module named LockSheet_Code

VBA Code: 
Enum XLWorkShift
    xlDayShift = 1
    xlNightShift
    xlStartShift
    xlCancelShifts
    xlLockCells
End Enum

Sub LockSheet(ByVal WhatShift As XLWorkShift, ByVal wb As String)
    Dim DayOfWeek       As Variant
    Dim ws              As Worksheet
    Dim LockAllCells    As Boolean
    
    Const strPassword = "Password"
    
    'lock all cells before closing & saving
    LockAllCells = WhatShift = xlLockCells
    
    'day of week array
    DayOfWeek = Application.GetCustomListContents(xlDay)
    
    Application.ScreenUpdating = False
    
    'loop all weekday sheets & apply locked status
    For Each ws In Workbooks(wb).Worksheets(DayOfWeek)
        With ws
            .Unprotect strPassword
            .Range("A1:Y5,A7:Y7").Locked = WhatShift = xlNightShift Or LockAllCells
            .Range("A6:Y6,A8:Y8").Locked = WhatShift = xlDayShift Or LockAllCells
            .Protect strPassword
        End With
    Next ws
    
    If Not LockAllCells Then
        'activate today's sheet
        Worksheets(Format(Date, "ddd")).Activate
        Application.ScreenUpdating = True
        'inform user
        MsgBox IIf(WhatShift = xlDayShift, "Day", "Night") & " Cells have been unlocked", 64, "Information"
        're-set timer
        SetShift
    Else
        'activate sheet 1 & save
        Worksheets(1).Activate
        Workbooks(wb).Save
    End If
    
End Sub

This code In module named SetShift_Code

VBA Code: 
Sub SetShift(Optional ByVal WhatShift As XLWorkShift)
    Dim wb              As Workbook
    Dim i               As Long
    Dim DayShift        As Variant, NightShift As Variant, WhichShift   As Variant
    Dim NightShiftStart As Date, DayShiftStart As Date, CurrTime        As Date
    
    On Error GoTo myerror
    '-------------------------------------------------------------------------------------------------
    '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 & """ '"
    
    'apply shift timer
    If WhatShift <> xlCancelShifts Then
        
        Select Case CurrTime
            Case DayShiftStart To NightShiftStart
                'day shift - set nightshift timer
                Application.OnTime EarliestTime:=NightShiftStart, Procedure:=NightShift
                WhichShift = DayShift
            Case Else
                'night shift - set dayshift timer
                Application.OnTime EarliestTime:=DayShiftStart, Procedure:=DayShift
                WhichShift = NightShift
        End Select
        'when workbook first opened, unlock appropriate shift ranges in each weekday sheet
        If WhatShift = xlStartShift 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

These codes In ThisWorkbook Code Page

VBA Code: 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    SetShift xlCancelShifts
End Sub

Private Sub Workbook_Open()
    SetShift xlStartShift
End Sub

3 – It is important that your worksheets are named with recognised abbreviated weekday names i.e. Mon, Tue, Wed, Thu, Fri, Sat, Sun

I have only lightly tested solution and hopefully what I have done is correct - when you open then workbook code should change the locked status to the ranges for appropriate shift at specified time it will also set timer for the next shift.

When you close the workbook, timers should be cancelled & workbook saved.

Dave
 
Upvote 0
Hi dmt32,

Firstly thank you for all your help and hard work! So far the code is working how I'd expect with the exception that I only need the current day unlocked (Day or Nights) and the rest of the book to be locked. Then when we get into a new day, previous day locks and current day/shift unlocks.

Is this something you could look at?
 
Upvote 0
Anthony86 said:
I only need the current day unlocked (Day or Nights) and the rest of the book to be locked. Then when we get into a new day, previous day locks and current day/shift unlocks.
Click to expand...

Hi
Try this update & see if does what you want

VBA Code: 
Sub LockSheet(ByVal WhatShift As XLWorkShift, ByVal wb As String)
    Dim DayOfWeek       As Variant
    Dim ws              As Worksheet
    Dim LockAllCells    As Boolean
    Dim TodaySheet      As String
    
    Const strPassword As String = "Password"
    
    'variable to select todays sheet
    TodaySheet = Format(Date, "ddd")
    
    'lock all cells before closing & saving
    LockAllCells = WhatShift = xlLockCells
    
    'day of week array
    DayOfWeek = Application.GetCustomListContents(xlDay)
    
    Application.ScreenUpdating = False
    
    'loop all weekday sheets & apply locked status
    For Each ws In Workbooks(wb).Worksheets(DayOfWeek)
        With ws
            .Unprotect strPassword
            .Visible = xlSheetVisible
            'if you only make today sheet visible, un rem this line
            '.Visible = IIf(.Name = TodaySheet And Not LockAllCells, xlSheetVisible, xlSheetVeryHidden)
            .Range("A1:Y5,A7:Y7").Locked = WhatShift = xlNightShift Or LockAllCells Or ws.Name <> TodaySheet
            .Range("A6:Y6,A8:Y8").Locked = WhatShift = xlDayShift Or LockAllCells 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

Dave
 
Upvote 0
Hi Dave,

That worked as a treat. In the last lot of code I had, it would clear contents a day ahead for ranges B5:Y8(Then lock). So if current day is Tuesday, then Wednesday it would clear those ranges. The only exception with this is Saturday, it doesn't need to clear the contents on Sunday, just needs to keep Sunday unlocked for all.
 
Upvote 0
Anthony86 said:
Hi Dave,

That worked as a treat. In the last lot of code I had, it would clear contents a day ahead for ranges B5:Y8(Then lock). So if current day is Tuesday, then Wednesday it would clear those ranges. The only exception with this is Saturday, it doesn't need to clear the contents on Sunday, just needs to keep Sunday unlocked for all.
Click to expand...

See if this update does what you want

VBA Code: 
Sub LockSheet(ByVal WhatShift As XLWorkShift, ByVal wb As String)
    'Ver 3 5th November 2024
    
    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
    
    Const strPassword As String = "Password"
    
    'day of week array
    DayOfWeek = Application.GetCustomListContents(xlDay)
    
    'day of week (monday = 1)
    WeekDayNum = Weekday(Date, vbMonday)
    
    'variable for todays sheet
    TodaySheet = DayOfWeek(WeekDayNum)
    'variable for nextday sheet
    NextDaySheet = DayOfWeek(WeekDayNum + 1)
    
    'lock which cells
    LockAllCells = WhatShift = xlLockCells
    LockDayShift = WhatShift = xlNightShift 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

Dave
 
Upvote 0
Hi Dave,

Getting a runtime error back.

1731233763427.png


1731233786283.png
 
Upvote 0
Try replacing that line with following

VBA Code: 
NextDaySheet = DayOfWeek(IIf(WeekDayNum = 7, 1, WeekDayNum + 1))

Dave
 
Upvote 0
That seemed to work. Everything seems to be working as should so will let it overlap into the evening to see if it works as expected. Appreciate all your hard work!!
 
Upvote 0
Anthony86 said:
That seemed to work. Everything seems to be working as should so will let it overlap into the evening to see if it works as expected. Appreciate all your hard work!!
Click to expand...

Pleased to hear all seems ok & appreciate your feedback but having had more time to take a further look I suspect suggested change may not allow next day values for Monday to be cleared?
If you find this is so then try the following update to that part of the code

VBA Code: 
    WeekDayNum = IIf(WeekDayNum = 7, 1, WeekDayNum + 1)
    'variable for nextday sheet
    NextDaySheet = DayOfWeek(WeekDayNum)

but if all is working as required, just leave as posted earlier.


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
272
RoryA
RoryA
N
  • Question Question
VBA - Intersect code being re-initiated
Replies
1
Views
233
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,851
Messages
6,181,395
Members
453,034
Latest member
mikdadhussain

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