Protect Workbook based on Date

[Alex]

Is there way to protect a worksheet from editing after a certain date? For
example, I input values for the month of June, but after say 60 days I cannot
changes the values for worksheet June unless I enter a password.

 

[JLatham]

There are a lot of "IF"s here, but I'll assume that a worksheet's name would
simply be the name of the month or the 3-letter abbreviation for a month.
Nothing else!

If that's the case, then this code, placed in each sheet's
Worksheet_Activate() code section would probably do it for you:

Private Sub Worksheet_Activate()
Dim myMonthNum As Integer
Dim lastDay As Integer

Select Case UCase(Trim(Me.Name))
Case Is = "JAN", "JANUARY"
myMonthNum = 1
lastDay = 31
Case Is = "FEB", "FEBRUARY"
myMonthNum = 2
lastDay = 28 ' not concerned with leap years
Case Is = "MAR", "MARCH"
myMonthNum = 3
lastDay = 31
Case Is = "APR", "APRIL"
myMonthNum = 4
lastDay = 30
Case Is = "MAY"
myMonthNum = 5
lastDay = 31
Case Is = "JUN", "JUNE"
myMonthNum = 6
lastDay = 30
Case Is = "JUL", "JULY"
myMonthNum = 7
lastDay = 31
Case Is = "AUG", "AUGUST"
myMonthNum = 8
lastDay = 31
Case Is = "SEP", "SEPTEMBER"
myMonthNum = 9
lastDay = 30
Case Is = "OCT", "OCTOBER"
myMonthNum = 10
lastDay = 31
Case Is = "NOV", "NOVEMBER"
myMonthNum = 11
lastDay = 30
Case Is = "DEC", "DECEMBER"
myMonthNum = 12
lastDay = 31
Case Else
'DO NOTHING
End Select
If myMonthNum > 0 Then
If myMonthNum > Month(Now()) Then
'the month must have been last year?
If Now() > DateSerial(Year(Now()) - 1, myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
Else
'the month is in same year as now()'s year
If Now() > DateSerial(Year(Now()), myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
End If
End Sub

To put the code into the proper place, for each sheet you need to test,
right-click on the sheet's name tab and choose [View Code] from the popup
list. Then copy and paste the code above into the module presented.

Then when you choose a worksheet, if it's more than 60 days beyond the end
of the month for that sheet, it'll be protected, otherwise it'll be
unprotected. If you need to use a password to protect/unprotect the sheets
then code like this needs to be used:
Me.Protect password:="myPassword123"
Me.UnProtect password:="myPassword123"

Hope this helps.

 

[Alex]

If this works; I owe you a beer.

There are a lot of "IF"s here, but I'll assume that a worksheet's name would
simply be the name of the month or the 3-letter abbreviation for a month.
Nothing else!

If that's the case, then this code, placed in each sheet's
Worksheet_Activate() code section would probably do it for you:

Private Sub Worksheet_Activate()
Dim myMonthNum As Integer
Dim lastDay As Integer

Select Case UCase(Trim(Me.Name))
Case Is = "JAN", "JANUARY"
myMonthNum = 1
lastDay = 31
Case Is = "FEB", "FEBRUARY"
myMonthNum = 2
lastDay = 28 ' not concerned with leap years
Case Is = "MAR", "MARCH"
myMonthNum = 3
lastDay = 31
Case Is = "APR", "APRIL"
myMonthNum = 4
lastDay = 30
Case Is = "MAY"
myMonthNum = 5
lastDay = 31
Case Is = "JUN", "JUNE"
myMonthNum = 6
lastDay = 30
Case Is = "JUL", "JULY"
myMonthNum = 7
lastDay = 31
Case Is = "AUG", "AUGUST"
myMonthNum = 8
lastDay = 31
Case Is = "SEP", "SEPTEMBER"
myMonthNum = 9
lastDay = 30
Case Is = "OCT", "OCTOBER"
myMonthNum = 10
lastDay = 31
Case Is = "NOV", "NOVEMBER"
myMonthNum = 11
lastDay = 30
Case Is = "DEC", "DECEMBER"
myMonthNum = 12
lastDay = 31
Case Else
'DO NOTHING
End Select
If myMonthNum > 0 Then
If myMonthNum > Month(Now()) Then
'the month must have been last year?
If Now() > DateSerial(Year(Now()) - 1, myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
Else
'the month is in same year as now()'s year
If Now() > DateSerial(Year(Now()), myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
End If
End Sub

To put the code into the proper place, for each sheet you need to test,
right-click on the sheet's name tab and choose [View Code] from the popup
list. Then copy and paste the code above into the module presented.

Then when you choose a worksheet, if it's more than 60 days beyond the end
of the month for that sheet, it'll be protected, otherwise it'll be
unprotected. If you need to use a password to protect/unprotect the sheets
then code like this needs to be used:
Me.Protect password:="myPassword123"
Me.UnProtect password:="myPassword123"

Hope this helps.

Is there way to protect a worksheet from editing after a certain date? For
example, I input values for the month of June, but after say 60 days I cannot
changes the values for worksheet June unless I enter a password.

 

[JLatham]

I think it'll work. Now if you keep more than one year's worth of monthly
sheets in the same workbook, obviously there can only be one sheet named
[June] in the book!
We could really pin things down if there was a cell on the sheet that held
the complete date to base the 60 days on, then we wouldn't have to do any
guessing at all.
Also, if it works reasonably well, this code could all be moved into the
Workbook_SheetActivate() procedure with an added test for the name of the
sheet so that non-month sheets would be ignored. This has the advantage of
making the size of the .xls file smaller, and the feature goes with the
workbook so you could base new workbooks on it and not have to worry with
adding monthly sheets and placing the code into them throughout the year.

The code that I've provided does become "part of the worksheet", so you can
set it up in one sheet and then copy that sheet several times in the same
workbook and just give the new sheets the proper month name. Similarly, to
start a new year's workbook, you can either make a copy of the workbook and
then clear out all data in the monthly sheets, or you could start a new
wokbook and just copy one of these sheets into it, clear out the data in it
and then make copies of it in the new book, renaming each copied sheet as
required.

If this works; I owe you a beer.

There are a lot of "IF"s here, but I'll assume that a worksheet's name would
simply be the name of the month or the 3-letter abbreviation for a month.
Nothing else!

If that's the case, then this code, placed in each sheet's
Worksheet_Activate() code section would probably do it for you:

Private Sub Worksheet_Activate()
Dim myMonthNum As Integer
Dim lastDay As Integer

Select Case UCase(Trim(Me.Name))
Case Is = "JAN", "JANUARY"
myMonthNum = 1
lastDay = 31
Case Is = "FEB", "FEBRUARY"
myMonthNum = 2
lastDay = 28 ' not concerned with leap years
Case Is = "MAR", "MARCH"
myMonthNum = 3
lastDay = 31
Case Is = "APR", "APRIL"
myMonthNum = 4
lastDay = 30
Case Is = "MAY"
myMonthNum = 5
lastDay = 31
Case Is = "JUN", "JUNE"
myMonthNum = 6
lastDay = 30
Case Is = "JUL", "JULY"
myMonthNum = 7
lastDay = 31
Case Is = "AUG", "AUGUST"
myMonthNum = 8
lastDay = 31
Case Is = "SEP", "SEPTEMBER"
myMonthNum = 9
lastDay = 30
Case Is = "OCT", "OCTOBER"
myMonthNum = 10
lastDay = 31
Case Is = "NOV", "NOVEMBER"
myMonthNum = 11
lastDay = 30
Case Is = "DEC", "DECEMBER"
myMonthNum = 12
lastDay = 31
Case Else
'DO NOTHING
End Select
If myMonthNum > 0 Then
If myMonthNum > Month(Now()) Then
'the month must have been last year?
If Now() > DateSerial(Year(Now()) - 1, myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
Else
'the month is in same year as now()'s year
If Now() > DateSerial(Year(Now()), myMonthNum, lastDay) Then
Me.Protect
Else
Me.Unprotect
End If
End If
End Sub

To put the code into the proper place, for each sheet you need to test,
right-click on the sheet's name tab and choose [View Code] from the popup
list. Then copy and paste the code above into the module presented.

Then when you choose a worksheet, if it's more than 60 days beyond the end
of the month for that sheet, it'll be protected, otherwise it'll be
unprotected. If you need to use a password to protect/unprotect the sheets
then code like this needs to be used:
Me.Protect password:="myPassword123"
Me.UnProtect password:="myPassword123"

Hope this helps.

Is there way to protect a worksheet from editing after a certain date? For
example, I input values for the month of June, but after say 60 days I cannot
changes the values for worksheet June unless I enter a password.