Macro for protecting and unprotecting multiple worksheets

[saltnsnails]

I would say that I am a moderate user of Excel and I need some help with
running a Macro. I have a workbook that has about 60 pages in it that
several people have access to in order to edit information on each of the
sheets. Each sheet has a Vlookup table that I am constantly modifying to
keep items current. My problem is that I am unlocking worksheets all day
long. The password is the same on all of the sheets. Is there a simple
macro I can run to unlock the entire workbook rather than individually
unlocking each sheet? And the same thing when I am finished and putting the
file back. Can I run a macro to reassign the password protection on all of
the sheets in the workbook? Thanks!

 

[Dave Peterson]

Option Explicit
Sub UnprotectAll()
dim wks as worksheet
for each wks in activeworkbook.worksheets
wks.unprotect password:="topsecret"
next wks
End Sub
Sub ProtectAll()
dim wks as worksheet
for each wks in activeworkbook.worksheets
wks.protect password:="topsecret"
next wks
End Sub

 

[saltnsnails]

Thank you but I don't know what to do with that? Where do I enter it? How
do I use it? I am still kind of new to this stuff. Thanks!

 

[Dave Peterson]

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Short course:

Open your workbook.
Hit alt-f11 to get to the VBE (where macros/UDF's live)
hit ctrl-R to view the project explorer
Find your workbook.
should look like: VBAProject (yourfilename.xls)

right click on the project name
Insert, then Module
You should see the code window pop up on the right hand side

Paste the code in there.

And while you're in the VBE...
select your poject
Tools|VBAProject Properties|Protection tab
Give it a memorable password.

It'll make finding the password a little more difficult--keep prying eyes out of
your code!

Thank you but I don't know what to do with that? Where do I enter it? How
do I use it? I am still kind of new to this stuff. Thanks!

 

[saltnsnails]

OMG!!!! Thank you!!! AWESOME AWESOME AWESOME!!!! The keystrokes I am going
to save!!!! Thanks!

 

[brumanchu]

Dave,
If I wanted to share a workbook that uses this macro to protect/unprotect
the sheets, could it be modified to promt me for the password? Otherwise the
share-ees could run the macro and still gain access.

Thanks for the help,
Bruce

 

[Gord Dibben]

Option Explicit
Sub UnprotectAll()
Dim wks As Worksheet
Pword = InputBox("enter the password")
On Error GoTo endit
For Each wks In ActiveWorkbook.Worksheets
wks.Unprotect Password:=Pword
Next wks
endit:
MsgBox "Incorrect Password"
End Sub

Correct Pword would be "topsecret" if you used the ProtectAll sub


Gord Dibben MS Excel MVP

Dave,
If I wanted to share a workbook that uses this macro to protect/unprotect
the sheets, could it be modified to promt me for the password? Otherwise the
share-ees could run the macro and still gain access.

Thanks for the help,
Bruce

 

[Dave Peterson]

You may want to put it in a different workbook and not share that workbook with
the macro.

Then you can open the macro workbook and open the real workbook

And with the real workbook open, you can use:
alt-f8
and run either macro.

====
Or...


Option Explicit
Sub UnprotectAll()
Dim wks As Worksheet
Dim pwd As String
pwd = InputBox(Prompt:="What's the password, Kenny?")

If Trim(pwd) = "" Then
Exit Sub
End If

For Each wks In ActiveWorkbook.Worksheets
With wks
If .ProtectContents = True _
Or .ProtectDrawingObjects = True _
Or .ProtectScenarios = True Then
On Error Resume Next
.Unprotect Password:=pwd
If Err.Number <> 0 Then
MsgBox "Something went wrong with: " & wks.Name
Err.Clear
'exit for 'stop trying???
End If
On Error GoTo 0
End If
End With
Next wks

End Sub
Sub ProtectAll()
Dim wks As Worksheet
Dim pwd As String
pwd = InputBox(Prompt:="What's the password, Kenny?")

If Trim(pwd) = "" Then
Exit Sub
End If

For Each wks In ActiveWorkbook.Worksheets
With wks
If .ProtectContents = True _
Or .ProtectDrawingObjects = True _
Or .ProtectScenarios = True Then
'do nothing, it's already protected
Else
On Error Resume Next
.Protect Password:=pwd
If Err.Number <> 0 Then
MsgBox "Something went wrong with: " & wks.Name
Err.Clear
'exit for 'stop trying???
End If
On Error GoTo 0
End If
End With
Next wks
End Sub

Dave,
If I wanted to share a workbook that uses this macro to protect/unprotect
the sheets, could it be modified to promt me for the password? Otherwise the
share-ees could run the macro and still gain access.

Thanks for the help,
Bruce