VBA to protect all sheets with password AND options of selecting locked/unlocked cells and editing objects

conky4

New Member
Joined
Nov 5, 2012
Messages
24
Hi, I'm new to VBA and need help. I have a workbook with 40 sheets in it that I need to protect. I'd prefer to do this all at once. Users need access into some of the sheets so I want to protect the sheets and allow them to select locked and unlocked cells...along with allow them the ability to add comments to cells. I have this code for locking the sheets...just don't know how to add in the selecting locked/unlocked cells and editing objects to the code. Any help is GREATLY appreciated!!:biggrin:

Sub ProtectAll()
Dim S As Object
Dim pWord1 As String, pWord2 As String
pWord1 = InputBox("Please Enter the password")
If pWord1 = "" Then Exit Sub
pWord2 = InputBox("Please re-enter the password")

If pWord2 = "" Then Exit Sub
'make certain passwords are identical
If InStr(1, pWord2, pWord1, 0) = 0 Or _
InStr(1, pWord1, pWord2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If
For Each ws In Worksheets
ws.Protect Password:=pWord1
Next
MsgBox "All sheets Protected."
End Sub
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Welcome to the Board!

Recording a macro setting the protection options you want will give you that.

HTH,
 
Upvote 0
Welcome to the Board!

Recording a macro setting the protection options you want will give you that.

HTH,

When I record the macro this is what I get...how do I put that into the prior code...or where? And it needs to apply to all sheets, not just the active sheet.

THANKS!

sub
ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True
Application.Goto Reference:="Macro4"
End Sub
 
Upvote 0
ws.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:=pWord1

Note that inserting comments isn't an option, but you can add code for it:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> AddComment()<br>    <SPAN style="color:#00007F">Dim</SPAN> ans <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    <SPAN style="color:#00007F">With</SPAN> ActiveSheet<br>        .Unprotect Password:=pWord1<br>        <br>        ans = InputBox("Please enter your comment", "Comment")<br>        <br>        <SPAN style="color:#00007F">With</SPAN> ActiveCell<br>            .AddComment<br>            .Comment.Text Text:=ans<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>        <br>        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=pWord1<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

HHT,
 
Upvote 0
ws.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:=pWord1

Note that inserting comments isn't an option, but you can add code for it:

Sub AddComment()
****Dim ans As String
****
****With ActiveSheet
********.Unprotect Password:=pWord1
********
********ans = InputBox("Please enter your comment", "Comment")
********
********With ActiveCell
************.AddComment
************.Comment.Text Text:=ans
********End With
********
********.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=pWord1
****End With

End Sub


HHT,

Ready to pull my hair out :eeek: I keep getting error on the red.


Sub ProtectAll()
Dim ws As Worksheet
Dim S As Object
Dim pWord1 As String, pWord2 As String
ws.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:=pWord1

pWord1 = InputBox("Please Enter the password")
If pWord1 = "" Then Exit Sub
pWord2 = InputBox("Please re-enter the password")

If pWord2 = "" Then Exit Sub
'make certain passwords are identical
If InStr(1, pWord2, pWord1, 0) = 0 Or _
InStr(1, pWord1, pWord2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If
For Each ws In Worksheets
ws.Protect Password:=pWord1
Next
MsgBox "All sheets Protected."
Exit Sub
 
Upvote 0
You're trying to protect the sheet before setting the password variable. Try:

<font face=Calibri><SPAN style="color:#00007F">Sub</SPAN> ProtectAll()<br>    <SPAN style="color:#00007F">Dim</SPAN> ws <SPAN style="color:#00007F">As</SPAN> Worksheet<br>    <SPAN style="color:#00007F">Dim</SPAN> S <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN><br>    <SPAN style="color:#00007F">Dim</SPAN> pWord1 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN>, pWord2 <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN><br>    <br>    pWord1 = InputBox("Please Enter the password")<br>        <SPAN style="color:#00007F">If</SPAN> pWord1 = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    pWord2 = InputBox("Please re-enter the password")<br>        <SPAN style="color:#00007F">If</SPAN> pWord2 = "" <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>    <br>    <SPAN style="color:#007F00">'   make certain passwords are identical</SPAN><br>        <SPAN style="color:#00007F">If</SPAN> InStr(1, pWord2, pWord1, 0) = 0 Or _<br>           InStr(1, pWord1, pWord2, 0) = 0 <SPAN style="color:#00007F">Then</SPAN><br>                MsgBox "You entered different passwords. No action taken"<br>               <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br> <br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> ws <SPAN style="color:#00007F">In</SPAN> Worksheets<br>        ws.Protect Password:=pWord1<br>    <SPAN style="color:#00007F">Next</SPAN> ws<br>    <br>    MsgBox "All sheets Protected."<br> <br> <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>
 
Upvote 0
You're trying to protect the sheet before setting the password variable. Try:

Sub ProtectAll()
Dim ws As Worksheet
Dim S As Object
Dim pWord1 As String, pWord2 As String

pWord1 = InputBox("Please Enter the password")
If pWord1 = "" Then Exit Sub
pWord2 = InputBox("Please re-enter the password")
If pWord2 = "" Then Exit Sub

' make certain passwords are identical
If InStr(1, pWord2, pWord1, 0) = 0 Or _
InStr(1, pWord1, pWord2, 0) = 0 Then
MsgBox "You entered different passwords. No action taken"
Exit Sub
End If

For Each ws In Worksheets
ws.Protect Password:=pWord1
Next ws

MsgBox "All sheets Protected."

End Sub
[/QUOTE
That's basically what I had originally what about the
ws.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:=pWord1

where does that go?
 
Upvote 0
Put it at the end with the For Each loop:

Code:
For Each ws In Worksheets
    ws.Protect Contents:=True, Scenarios:=True, Password:=pWord1
Next ws
 
Upvote 0
ws.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, Password:=pWord1

Note that inserting comments isn't an option, but you can add code for it:

Sub AddComment()
****Dim ans As String
****
****With ActiveSheet
********.Unprotect Password:=pWord1
********
********ans = InputBox("Please enter your comment", "Comment")
********
********With ActiveCell
************.AddComment
************.Comment.Text Text:=ans
********End With
********
********.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=pWord1
****End With

End Sub


HHT,


Thank you ....thank you!
 
Upvote 0
Hey guys,

Regarding the above, not very well up on VBA. Do I put the above code in a module, In "This Workbook" or on each sheet? if not each sheet do I need something on each sheet aswell? Also where exactly do you put the password you want to be used?
 
Upvote 0

Forum statistics

Threads
1,223,104
Messages
6,170,125
Members
452,303
Latest member
c4cstore

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top