Private Sub LockWorkBook()
Dim wrkSheetTot As Integer
Dim i As Integer
wrkSheetTot = ActiveWorkbook.Worksheets.Count
Sheets("Banking").Select
Activesheet.UnProtect "TEST"
Range("H4:H6").Select
Selection.Locked = False
For i = 1 To wrkSheetTot
ActiveWorkbook.Worksheets(i).Select
ActiveSheet.Protect "TEST", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Next
ActiveWorkbook.Worksheets("Banking").Select
ActiveWorkbook.Worksheets("IncomeData").Visible = False
ActiveWorkbook.Worksheets("BankingData").Visible = False
ActiveWorkbook.Worksheets("TelephoneNos").Visible = False
ActiveWorkbook.Protect "TEST", Structu=True,
Windows:=False
End Sub

--
Regards,
Tom Ogilvy


"Alastair MacFarlane" wrote in message
...
Dear All,

I am trying to create a procedure that:

(a) Create an area on a sheet "Banking" that users can
enter values where the remainder of the spreadsheet is
locked.
(b) Loops round all the sheets in the workbook and locks
them.
(c) Hides the worksheets with the exception of the
sheet "Banking".
(d) Protects the workbook.

The problem I am having is that I get the message "The
cell you are trying to change is protected and therefore
read only". I cannot identify the cause of this message. I
have tried setting Application.DisplayAlerts = False to
stop the message or Break On All Errors, but with no luck.
Can anyone help me?

After I click on the error message the workbook is set up
the way I want it but I don’t want to see this message.

Private Sub LockWorkBook()
Dim wrkSheetTot As Integer
Dim i As Integer
wrkSheetTot = ActiveWorkbook.Worksheets.Count
Sheets("Banking").Select
Range("H4:H6").Select
Selection.Locked = False
For i = 1 To wrkSheetTot
ActiveWorkbook.Worksheets(i).Select
ActiveSheet.Protect "TEST", DrawingObjects:=True,
Contents:=True, Scenarios:=True
Next
ActiveWorkbook.Worksheets("Banking").Select
ActiveWorkbook.Worksheets("IncomeData").Visible = False
ActiveWorkbook.Worksheets("BankingData").Visible = False
ActiveWorkbook.Worksheets("TelephoneNos").Visible = False
ActiveWorkbook.Protect "TEST", Structu=True,
Windows:=False
End Sub