Locking Sheet after Particular Date

[Bavliya]

Hello Everyone

can you help me for Locking Sheet after Particular Date.

I have Excel file which have 13 sheet, first sheet is Master Sheet and rest of it has represent 12 month, in each sheet has monthly data. I want to Lock current sheet after 8 of next month. Rest of it will be remain unlock till his Lock date.

Thank you.

 

[Bavliya]

Here is a version, checked, and I have added option to use sheet names. See comments

Option Explicit

Private Sub Workbook_Open()
  
    'lock sheets if necessary
    LockAll
End Sub


Private Sub LockAll()
    Dim wsWS As Worksheet
    Dim rDate As Range
    Dim dtNow As Date
    Dim vMonths As Variant
    Dim iDay As Integer, iMonth As Integer, iWBYear As Integer, lR As Long
    Dim bProtect As Boolean
    Dim sMonth As String
  
    Const sPW As String = "MyPassword"  '<<<< to be modified >>>>
    Const sMONTHS As String = "january,february,march,april,may,june,july,august,september,october,november,december" '<< note: All lower case
  
    'get year for the workbook - assuming it is in Master Sheet in some cell. <<<< Ammend as required >>>>
    iWBYear = Sheets("Master Sheet").Range("A1")
  
    'store todays day and month number
    iDay = Day(Date)
    iMonth = Month(Date)
  
    ' make an array with each of the month names
    vMonths = Split(sMONTHS, ",")
  
    'loop through each of the sheets
    For Each wsWS In Me.Sheets
        If Not wsWS.Name Like "Master Sheet" Then
' <<<< there are two options here. Comment out the one not to be used >>>>
        'Option 1 - month name on each sheet
            ' Assumes month is in cell A1 on each sheet. Modify address as required
            Set rDate = wsWS.Range("A1")   '<<<< modify address to suit >>>>
            sMonth = LCase(rDate.Text)
        'Option 2  - Month name on the tabs
            ' alternative: check tab names
            sMonth = LCase(wsWS.Name)
'<<<>>>
            'now check if the sheet should be locked - after the 8th of the next month
            For lR = 0 To 11    'vMonths is an array starting from 0
                If Trim(sMonth) Like vMonths(lR) Then
                    Exit For
                End If
            Next lR
            lR = lR + 1     'lR now has the month number of the sheet
          
            Select Case lR
                Case 13
                    'error, sheet cell A1 does not contain valid month
                    MsgBox prompt:="Sheet " & wsWS.Name & " does not contain a valid month name in" & vbCrLf & _
                                    rDate.Address & " or as tabname. Please check the sheets so each has the month's name in this cell", _
                                    Title:="Error: Month name not found in sheet"
                Case 12
                    'December - needs to link to next year January
                    If Date > DateSerial(iWBYear, 1, 7) Then
                        bProtect = True
                    End If
                Case Else
                    ' all other months
                    If (iMonth = lR + 1 And iDay > 7) Or iMonth > lR + 1 Then
                        bProtect = True
                    End If
            End Select
            If bProtect Then
                wsWS.Protect sPW, _
                            AllowSorting:=True, _
                            AllowFiltering:=True, _
                            AllowUsingPivotTables:=True
                bProtect = False
            End If
        End If
    Next wsWS
End Sub

STILL HERE ARE ERROR SHOW LIKE

 

[sijpie]

Do you have a sheet called "Master Sheet"? The code is looking for it. If you master sheet has a different name, then replace it in the code