How do I lock a worksheet and stop data entry after a certain date and time?

andyamcconnell · May 23, 2024

Hi,
I have a spread sheet for managers to enter the hours worked by staff each week. The spreadsheet has a separate work sheet for every week (52 sheets). The spread sheet is used to calculate staff pay and after the week is over I no longer want managers to change the input data. Is this possible?

The sheet is currently protected apart from the high lighted grey areas, which allow the managers to input hours (although these cells do have data Validation to allow only certain data to be entered).

In the attached example, worksheet "week 27" the sheet is dated week commencing Monday 29/04/2024. Ideally I would like data to be entered up until 12.00 the following Monday (6/05/2024) and after that it will become locked. "Week 28" will be from week commencing Monday 6/05/2024 and it will ideally close on Monday 13/05/2024 at 12.00 and so on.

I have been googling around trying to figure this out for a while, but have had no success, and it's driving me knots. So any help would be greatly appreciated.

Andy

Jeffrey Mahoney · May 23, 2024

Ok, so there's a lot going on here. I created a reference table for the Week sheets and the expiration for each on a sheet Called "SETUP". Change the year and the week dates follow. The code needs to be placed in THISWORKBOOK module in VBA. Every time a user opens the workbook it checks each sheet expiration date and time and does one of two things.
* If the expiration is before today's date at noon it then locks all cells on the sheet
* If the expiration date/time is after today's date at noon it then unlocks a range on every Week sheet called "EditRng"

You will need to create a named range on every Week sheet called EditRng that includes the cells you want the user to edit in the course of finishing the timesheet. The Named Ranges need to be a Worksheet Scope. You also need to create a Named Range called ExpireRng on the Setup. The range for this should be the column of Expiration Dates not including the header.

VBA Code:

Private Sub Workbook_Open()
  Dim Cel As Range
  Dim ExpireRng As Range
  Dim Dt As Date
  Dim ShtName As String
  Dim Sht As Worksheet
  
  Set ExpireRng = Sheets("SETUP").Range("ExpireRng")
  
  For Each Cel In ExpireRng
    Dt = Cel.Value
    If Dt < Now Then
      ShtName = Cel.Offset(0, -1).Value
      If IsSheet(ShtName) Then
        Set Sht = Sheets(ShtName)
        Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
          , AllowFormattingCells:=True, UserInterfaceOnly:=True
        Sht.Cells.Locked = True
      End If
    Else
      ShtName = Cel.Offset(0, -1).Value
      If IsSheet(ShtName) Then
        Set Sht = Sheets(ShtName)
        Sht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
          , AllowFormattingCells:=True, UserInterfaceOnly:=True
        Sht.Range("EditRng").Locked = False
      End If
    End If
  Next Cel

End Sub


Function IsSheet(ShtName As String) As Boolean
  Dim Sht As Worksheet
  On Error Resume Next
  Set Sht = Sheets(ShtName)
  On Error GoTo 0
  If Not Sht Is Nothing Then IsSheet = True
  
End Function

BookAAAAA 20240523.xlsm