View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Gleam Gleam is offline
external usenet poster
 
Posts: 87
Default Locking worksheet based on the cell value

I have just read the bit about hiding sheets. I think you need to have at
least two sheets open, otherwise the user has to change a cell to get the
macros to run. With this method the user selects another sheet and the macro
runs.

Sub ProtectSht()
' Protect sheet with a password if sheet not
' valid for today
' Date of sheet is assumed to be in cell A1
' Since this may be a file which is left open permanently, then
' this routine should be placed in a module and then
' This workbook / workbook / sheet activate should call this routine
' If the file is likely to be left open past midnight then
' This workbook / workbook / sheet change should call this routine.
' This will allow just one change to be made after midnight to
' the currently selected cell.
Dim NShts As Integer, i1 As Integer
Dim UA1 As Range, UA2 As Range, UA3 As Range, UAT As Range
With ActiveWorkbook
.Unprotect "Pass"

NShts = .Sheets.Count
For i1 = 1 To NShts
' Set user areas - users can enter data in these cells
Set UA1 = .Sheets(i1).Range("B5:B12") ' User Area 1
Set UA2 = .Sheets(i1).Range("F5:G12") ' User Area 2
Set UA3 = .Sheets(i1).Range("A14:B17") 'User Area 3
Set UAT = Union(UA1, UA2, UA3)
.Sheets(i1).Unprotect "Pass"
With UAT.Interior ' colour user cells yellow
.ColorIndex = 6
.Pattern = xlSolid
End With
If .Sheets(i1).Range("A1").Value < Date Then
UAT.Locked = True
If .Sheets(i1).Range("A1").Value < Date + 1 Then
.Sheets(i1).Visible = False
Else
.Sheets(i1).Visible = True
End If
Else
UAT.Locked = False
.Sheets(i1).Visible = True
End If
.Sheets(i1).Protect "Pass"
Next i1
.Protect Password:="Pass", Structu=True, Windows:=False
End With
End Sub


"0o0o0o0o" wrote:

Thank you for your help, I tried your code and it works fine, except in some
of the sheets that have a date other than today's, it allows user to enter
value in one cell, and then locks the sheet.
Another problem: each worksheet contains bunch of cells with formulas,
allowing users to edit cells with formulas. Most of the people that will be
using this workbook have limited knowledge of Excel so I'm afraid they will
delete some formulas (by mistake of course).
I tried editing your code to hide the worksheet if A1 cell is not equal to
today's date, but it's not working. Any ideas?
Thank you again.

"Gleam" wrote:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
' Protect sheet with a password if sheet not
' valid for today
' Date of sheet is assumed to be in cell A1. Password is "Pass"
' Since this may be a file which is left open permanently, then
' this routine might be placed under
' This workbook / workbook / sheet change
Dim NShts As Integer, i1 As Integer
With ActiveWorkbook
NShts = .Sheets.Count
For i1 = 1 To NShts
If .Sheets(i1).Range("A1").Value < Date Then
ActiveWorkbook.Sheets(i1).Protect "Pass"
End If
Next i1
End With

End Sub


"0o0o0o0o" wrote:

I have a workbook containing 14 worksheets that are used as daily shift
report for each day of the biwekly pay period. Supervisors fill out reports
on a daily basis and managers review them every couple of days. I'd like to
limit user's ability to filling out today's report only (maybe a code that
would compare the date on the report with cell that contains =TODAY()
function, and locks the worksheet for editing if those two values don't
mach). The idea is not to allow anyone to go back and edit reports.
Any help on this would be greatly appreciated.