Protect Work Sheet

D

Dave

Is there an simpler way to protect and un protect work sheets? This is how I
did it.

Thanks

Sub Protect()
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Sheets("Sheet1").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Sheets("Sheet2").Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True,
Scenarios:=True
Sheets("Sheet3").Select
End Sub
-------------------------------------------
Sub UnProtect()
Sheets("Sheet1").Select
ActiveSheet.UnProtect
Sheets("Sheet2").Select
ActiveSheet.UnProtect
Sheets("Sheet3").Select
End Sub
 
J

J.E. McGimpsey

Don't know about simpler, but this is shorter:

Public Sub Protect3()
Dim wkSht As Worksheet
For Each wkSht In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
wkSht.Protect DrawingObjects:=True, _
Contents:=True, Scenarios:=True
Next wkSht
End Sub
 
J

jee22

Try Tools>Protection>Protect sheet or workbook then add your pass word
Be careful if you forget it you wont be able to access the sheet/workbook

Happy new year
 
K

Ken Wright

Just in case you were looking for a general solution to avoid having to name the
sheets, then these are also from JE

Public Sub ToggleProtect1()
'Courtesy of J E McGimpsey

Const PWORD As String = "ken"
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
If .ProtectContents Then
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
Else
wkSht.Protect Password:=PWORD
statStr = statStr & ": Protected"
End If
End With
Next wkSht
MsgBox Mid(statStr, 2)
End Sub

-----------------------------------------------------------

Public Sub Toggleprotect2()
'Courtesy of J E McGimpsey

Const PWORD As String = "ken"
Dim wkSht As Worksheet

For Each sh In ActiveWorkbook.Worksheets
If sh.ProtectContents = False Then
sh.Protect PWORD
Else
sh.Unprotect PWORD
End If
Next sh
End Sub

-----------------------------------------------------------

Public Sub ProtectAllSheets()
'Space allowed for insertion of a password
'Code lists every sheet with it's protection status
Application.ScreenUpdating = False
Const PWORD As String = ""
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
wkSht.Protect Password:=PWORD
statStr = statStr & ": Protected"
End With
Next wkSht
MsgBox Mid(statStr, 2)
Application.ScreenUpdating = True
End Sub

-----------------------------------------------------------

Public Sub UnprotectAllSheets()
'Space allowed for insertion of a password
'Code lists every sheet with it's protection status
Application.ScreenUpdating = False
Const PWORD As String = ""
Dim wkSht As Worksheet
Dim statStr As String

For Each wkSht In ActiveWorkbook.Worksheets
With wkSht
statStr = statStr & vbNewLine & "Sheet " & .Name
wkSht.Unprotect Password:=PWORD
statStr = statStr & ": Unprotected"
End With
Next wkSht
MsgBox Mid(statStr, 2)
Application.ScreenUpdating = True
End Sub
 
K

Ken Wright

You're welcome, but it's JE that deserves the thanks, as they are his routines
:)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top