Option Explicit
Private Sub Workbook_Open()
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"
Const sMONTHS As String = "january,february,march,april,may,june,july,august,september,october,november,december"
iWBYear = Sheets("Master Sheet").Range("A1")
iDay = Day(Date)
iMonth = Month(Date)
vMonths = Split(sMONTHS, ",")
For Each wsWS In Me.Sheets
If Not wsWS.Name Like "Master Sheet" Then
Set rDate = wsWS.Range("A1")
For lR = 0 To 11
If Trim(LCase(rDate.Text)) Like vMonths(lR) Then
Exit For
End If
Next lR
lR = lR + 1
Select Case lR
Case 13
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
If Date > DateSerial(iWBYear, 1, 7) Then
bProtect = True
End If
Case Else
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