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.

 

[myall_blues]

Hi

Do you mean your workbook looks something like this, and for example the tab marked June you want to lock after July 8?

 

[sijpie]

Read the comments carefully. Where they are in between <<<< comment >>>> you need to do something


This code needs to go into the Workbook codesheet. Open the VBA editor, in the left panel you will see the workbook with all the sheets listed. The last item in the list is called Workbook. click on this to open its codesheet. Now paste the following in there.

It will run each time the workbook is opened.

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
   
    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
            ' Assumes month is in cell A1 on each sheet. Modify address as required
            Set rDate = wsWS.Range("A1")    '<<<< modify address to suit >>>>
           
            '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(LCase(rDate.Text)) 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 & ". 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

 

[Bavliya]

Hi

Do you mean your workbook looks something like this, and for example the tab marked June you want to lock after July 8?

View attachment 113514

it's like that..

 

[Bavliya]

Read the comments carefully. Where they are in between <<<< comment >>>> you need to do something


This code needs to go into the Workbook codesheet. Open the VBA editor, in the left panel you will see the workbook with all the sheets listed. The last item in the list is called Workbook. click on this to open its codesheet. Now paste the following in there.

It will run each time the workbook is opened.

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
  
    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
            ' Assumes month is in cell A1 on each sheet. Modify address as required
            Set rDate = wsWS.Range("A1")    '<<<< modify address to suit >>>>
          
            '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(LCase(rDate.Text)) 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 & ". 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

i just try code but it's show error like "subscript out of range"

 

[Bavliya]

 

[myall_blues]

See if this works for you. It needs to go in the code for 'ThisWorkbook'

Private Sub Workbook_Open()
    Dim ws As Worksheet, sheetDate As Date
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" Then
            sheetDate = DateValue("08-" & ws.Name)
            If Date > sheetDate Then
                ' If you want to use a password uncomment line below and change "pwd" to what you want.
                'ws.Protect Password:="pwd"
                ' If you don't need a password use line below
                ws.Protect
            End If
        End If
    Next ws
End Sub

 

[Bavliya]

See if this works for you. It needs to go in the code for 'ThisWorkbook'

Private Sub Workbook_Open()
    Dim ws As Worksheet, sheetDate As Date
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" Then
            sheetDate = DateValue("08-" & ws.Name)
            If Date > sheetDate Then
                ' If you want to use a password uncomment line below and change "pwd" to what you want.
                'ws.Protect Password:="pwd"
                ' If you don't need a password use line below
                ws.Protect
            End If
        End If
    Next ws
End Sub

after 8th of july it's lock july sheet.
july sheet lock after the 8th of aug.

 

[myall_blues]

Here's an amendment:

Private Sub Workbook_Open
    Dim ws As Worksheet, sheetDate As Date, NextSheetdate As Date
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> "Master" Then
            sheetDate = DateValue("08-" & ws.Name)
            NextSheetdate = DateSerial(Year(sheetDate), Month(sheetDate) + 1, Day(sheetDate))
            If Date > NextSheetdate Then
                ' If you want to use a password uncomment line below and change "pwd" to what you want.
                'ws.Protect Password:="pwd"
                ' If you don't need a password use line below
                ws.Protect
            End If
        End If
    Next ws
End Sub

 

[sijpie]

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