Macro to Protect all sheets in an workbook and set protection parameters 2

[MJV8198]

I am using Office 365 Excel 2016.

I am using Macro 1 to lock all sheets in the workbook. It pops up a message box so I can enter a password, verifies the password, and protects all the sheets. If the passwords do not match, it starts over.

I would like to use this macro in a workbook where I am using filtering. In thread 68-806201 I found Macro 2 which will Protect a single sheet and allow filtering. The problem is it uses a hard coded password and it only does one sheet.

Question- How do I combine Macro 2 into Macro 1?
Thank you for your Help


Macro 1

Sub protect_all_sheets()
top:
pass = InputBox("Enter Password?")
repass = InputBox("Verify Password")
If Not (pass = repass) Then
MsgBox "Your Passwords do not Match"
GoTo top
End If
For i = 1 To Worksheets.Count
If Worksheets(i).ProtectContents = True Then GoTo oops
Next
For Each Sheet In ActiveWorkbook.Worksheets
Sheet.Protect Password:=pass
Next
Exit Sub
oops: MsgBox "I think you have some sheets that are already protected. Please un-protect all sheets then running this Macro."
End Sub

Macro 2

ActiveSheet.Protect "pass", True, True, _
True , , , , , , , , , , True, True

ActiveSheet.EnableSelection = 1

 

[SkipVought]

Hi,

Sub protect_all_sheets()
    Dim pass As String, repass As String
    Dim i As Integer, sheet As Worksheet
    
    pass = InputBox("Enter Password?")
    repass = InputBox("Verify Password")
    
    If Not (pass = repass) Then
        MsgBox "Your Passwords do not Match"
        pass = InputBox("Enter Password?")
        repass = InputBox("Verify Password")
    End If
    
    For i = 1 To Worksheets.Count
        If Worksheets(i).ProtectContents Then
            MsgBox "I think you have some sheets that are already protected. " & _
                 "Please un-protect all sheets then running this Macro."
            Exit sub
        End If
    Next
    
    For Each sheet In ActiveWorkbook.Worksheets
        sheet.Protect pass, True, True, _
            True, , , , , , , , , , True, True

        sheet.EnableSelection = 1
    Next
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Deniall]

For years I have used the following pair of macros to protect & unprotect workbooks.[ ] I use them so much I converted them to an add-in, and have them able to be activated via Ctrl-Shift-P and Crtl-Shift-U shortcuts.

I see two potential, but minor, improvements in this thread's earlier offerings:
» Requiring double entry of the password before protecting;
» Checking whether anything is already protected before attempting my own protection.

Option Explicit
Option Base 1
Sub Protect_All()
'
'  Macro to apply a hardwired password to all sheets in a workbook and to the workbook itself.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim PassWd, Ans, ShtName As String, ShtType As String
Const Descr As String = "Macro to protect all worksheets etc"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to protect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get from the user the password to be used.
'
'  Note that the "Application." in front of the "InputBox" for the latter is necessary
'  to be able to distinguish between a blank password and a "cancel" response, since with it
'  a cancel will return a boolean "false", while without it a cancel will return an empty
'  string.
'
PassWd = Application.InputBox("Please enter the password you want to use:", Descr)
If VarType(PassWd) = vbBoolean Then
    If Not PassWd Then
        MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
        Exit Sub
    End If
End If
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo P_Failure
    '
    WorkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=PassWd
    '
    '  Allow user to select (but not change) locked cells.  Note that with some versions
    '  of Excel this setting does not persist (ie it gets forgotten when the workbook
    '  is saved.
    '
    WorkSht.EnableSelection = xlNoRestrictions
    '
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo P_Failure
    ThisChart.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now protect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo P_Failure
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts)." & Chr(13) & Chr(13) & _
       "Password used was """ & PassWd & """." & Chr(13) & Chr(13) & _
       "Take care not to forget it.", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
P_Failure:
MsgBox "Protection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Unprotect_All()
'
'  Macro to unprotect all sheets in a workbook, and the workbook itself.
'  It assumes that all these protections have been set with the same password.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim Ans, PassWd, ShtName As String, ShtType As String
Const Descr As String = "Macro to unprotect all worksheets etc"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to unprotect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get the password from the user.
'  (See above for comments on the "Application." bit.)
'
PassWd = Application.InputBox("Please enter the password:", Descr)
If VarType(PassWd) = vbBoolean Then
    If Not PassWd Then
        MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
        Exit Sub
    End If
End If
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo U_Failure
    WorkSht.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo U_Failure
    ThisChart.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now unprotect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo U_Failure
ActiveWorkbook.Unprotect Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts).", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
U_Failure:
MsgBox "Unprotection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

 

[MJV8198]

Hi Skip I tested you Macro and it works Perfectly.

Deniall- Thank you for your response- I tried your macro as well and it works very well except it is not allowing me to filter. Your code is way above my abilities to adjust. Can you provide further help?


Update- Deniall I figured out how to allow for the filtering, Thank you for your help. However in your comments before the code you mention a double entry of the password and checking to see if all sheets are unprotected. However when I run your code it does not confirm the password or check for protected sheets. Am I doing something wrong?

 

[Deniall]

You are mis-reading my second paragraph, which I now see is potentially ambiguous.[ ] What I was trying to say is that my macros do NOT have these features, and would be improved by having them included.[ ] (I may well get around to doing just that, but not right now.)

 

[MJV8198]

Hello Deniall,

I was testing your macro and I was able to change the code to require double entry of the password and check for locked sheets. If you do not check for locked sheets your spreadsheet chas the potential to have 2 passwords.

Option Explicit
Option Base 1
Sub Protect_All()
'
'  Macro to apply a hardwired password to all sheets in a workbook and to the workbook itself.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim PassWd, RePassWd, Ans, ShtName As String, ShtType As String, i As Integer
Const Descr As String = "Macro to protect all worksheets etc"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to protect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get from the user the password to be used and Verify the the password with a second entry
'  of the password. If they do not match loop through the entry process.
'
'  Note that the "Application." in front of the "InputBox" for the latter is necessary
'  to be able to distinguish between a blank password and a "cancel" response, since with it
'  a cancel will return a boolean "false", while without it a cancel will return an empty
'  string.
'
PassWd = Application.InputBox("Please enter the password you want to use:", Descr)
RePassWd = Application.InputBox("Please Re-enter the password:", Descr)
If Not (PassWd = RePassWd) Then
        MsgBox "Your Passwords do not Match"
        PassWd = InputBox("Enter Password?")
        RePassWd = InputBox("Verify Password")
    End If
'
'  This Section Checks to see if any of the sheets are currently Protected.
'  If it finds a protected sheet it stops the entry of an additional password
'
For i = 1 To Worksheets.Count
        If Worksheets(i).ProtectContents Then
            MsgBox "I think you have some sheets that are already protected. " & _
                 "Please un-protect all sheets then running this Macro."
            Exit Sub
        End If
    Next
    
If VarType(PassWd) = vbBoolean Then
    If Not PassWd Then
        MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
        Exit Sub
    End If
End If
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo P_Failure
    '
    WorkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, Password:=PassWd
    '
    '  Allow user to select (but not change) locked cells.  Note that with some versions
    '  of Excel this setting does not persist (ie it gets forgotten when the workbook
    '  is saved.
    '
    WorkSht.EnableSelection = xlNoRestrictions
    '
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo P_Failure
    ThisChart.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now protect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo P_Failure
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts)." & Chr(13) & Chr(13) & _
       "Password used was """ & PassWd & """." & Chr(13) & Chr(13) & _
       "Take care not to forget it.", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
P_Failure:
MsgBox "Protection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Unprotect_All()
'
'  Macro to unprotect all sheets in a workbook, and the workbook itself.
'  It assumes that all these protections have been set with the same password.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim Ans, PassWd, ShtName As String, ShtType As String
Const Descr As String = "Macro to unprotect all worksheets etc"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to unprotect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get the password from the user.
'  (See above for comments on the "Application." bit.)
'
PassWd = Application.InputBox("Please enter the password:", Descr)
If VarType(PassWd) = vbBoolean Then
    If Not PassWd Then
        MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
        Exit Sub
    End If
End If
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo U_Failure
    WorkSht.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo U_Failure
    ThisChart.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now unprotect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo U_Failure
ActiveWorkbook.Unprotect Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts).", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
U_Failure:
MsgBox "Unprotection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

 

[MJV8198]

Skip

You get a big thank you as I was able to look at your code and improve Deniall's code. I also like the efficiency of your code unfortunately I have not idea what I am doing so my changes were guesses that worked out well.

Thank you for your help.

Michael

 

[SkipVought]

Great. Just keep coding and coming back to Tek-Tips. Its been a huge help for me. I’ve learned a bunch and I’m still learning from these guys.

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[Deniall]

MJV

Well done.[ ] Your modifications work OK, except that they do not cover Chart Sheets.[ ] I have remedied this in what I present below, and at the same time I have (I hope) made thing a little bit more robust.[ ] Thanks for encouraging me on this little improvement project.

Option Explicit
Option Base 1

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Protect_All()
'
'  Macro to apply a (single) password to all sheets in a workbook and to the workbook itself.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim PassWd, RePassWd, Ans, ShtName As String, ShtType As String, I As Integer
Const Descr As String = "Macro to fully protect a workbook"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to protect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get from the user the password to be used and Verify the the password with a second entry
'  of the password. If they do not match repeat the entry process (up to 3 times).
'
'  Note that the "Application." in front of the "InputBox" for the latter is necessary
'  to be able to distinguish between a blank password and a "cancel" response, since with it
'  a cancel will return a boolean "false", while without it a cancel will return an empty
'  string.
'
For I = 1 To 3
    PassWd = Application.InputBox("Please enter the password you want to use:", Descr)
    If VarType(PassWd) = vbBoolean Then
        If Not PassWd Then
            MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
            Exit Sub
        End If
    End If
    '
    RePassWd = Application.InputBox("Please re-enter the password:", Descr)
    If VarType(RePassWd) = vbBoolean Then
        If Not RePassWd Then
            MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
            Exit Sub
        End If
    End If
    '
    If PassWd = RePassWd Then
        Exit For
    Else
        If I < 3 Then
            MsgBox "Your passwords do not match.  Try again.", , Descr
            GoTo Try_Again
        Else
            MsgBox "Another mis-match.  Three strikes and you're out.", vbOKOnly, Descr
            Exit Sub
        End If
    End If
Try_Again:
Next I
'
'  Check to see if any of the worksheets or chartsheets are currently protected.
'  If we find a protected sheet we abort the entire process.
'
For Each WorkSht In Worksheets
    If WorkSht.ProtectContents Then
        MsgBox "You appear to have some sheets that are already protected. " & Chr(13) & _
               "Please un-protect all sheets/charts before running this macro."
        Exit Sub
    End If
Next WorkSht
'
For Each ThisChart In Charts
    If ThisChart.ProtectContents Then
        MsgBox "You appear to have some charts that are already protected. " & Chr(13) & _
               "Please un-protect all sheets/charts before running this macro."
        Exit Sub
    End If
Next ThisChart
'
'  Checks all passed.  Can now get on with the main job.
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo P_Failure
    '
    WorkSht.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowSorting:=True, AllowFiltering:=True, Password:=PassWd
    '
    '  Allow user to select (but not change) locked cells.  Note that with some versions
    '  of Excel this setting does not persist (ie it gets forgotten when the workbook
    '  is saved.
    '
    WorkSht.EnableSelection = xlNoRestrictions
    '
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo P_Failure
    ThisChart.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now protect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo P_Failure
ActiveWorkbook.Protect Structure:=True, Windows:=False, Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts)." & Chr(13) & Chr(13) & _
       "Password used was """ & PassWd & """." & Chr(13) & Chr(13) & _
       "Take care not to forget it.", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
P_Failure:
MsgBox "Protection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub Unprotect_All()
'
'  Macro to unprotect all sheets in a workbook, and the workbook itself.
'  It assumes that all these protections have been set with the same password.
'
Dim WorkSht As Worksheet, ThisChart As Chart, NumbSheets As Long, NumbCharts As Long
Dim Ans, PassWd, ShtName As String, ShtType As String
Const Descr As String = "Macro to fully unprotect a workbook"
'
'  Warn user what is about to happen.
'
Ans = MsgBox("You are about to unprotect all sheets & charts in this workbook." & _
                  Chr(13) & Chr(13) & "Do you wish to continue?", _
                  vbYesNoCancel + vbDefaultButton1, Descr)
If Ans = vbCancel Or Ans = vbNo Then
    MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
    Exit Sub
End If
'
'  Get the password from the user.
'  (See above for comments on the "Application." bit.)
'
PassWd = Application.InputBox("Please enter the password:", Descr)
If VarType(PassWd) = vbBoolean Then
    If Not PassWd Then
        MsgBox "Operation cancelled at your request.", vbOKOnly, Descr
        Exit Sub
    End If
End If
'
'  Loop through all the worksheets.
'
NumbSheets = 0
ShtType = "Worksheet "
For Each WorkSht In Worksheets
    ShtName = WorkSht.Name
    On Error GoTo U_Failure
    WorkSht.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbSheets = NumbSheets + 1
Next WorkSht
'
'  Loop through all the charts.
'
NumbCharts = 0
ShtType = "Chart "
For Each ThisChart In Charts
    ShtName = ThisChart.Name
    On Error GoTo U_Failure
    ThisChart.Unprotect Password:=PassWd
    On Error GoTo 0
    NumbCharts = NumbCharts + 1
Next ThisChart
'
'  Now unprotect the workbook itself.
'
ShtType = ""
ShtName = "Workbook's structure"
On Error GoTo U_Failure
ActiveWorkbook.Unprotect Password:=PassWd
On Error GoTo 0
'
'  It's all over.
'
MsgBox "All done OK  (" & NumbSheets & " sheets and " & NumbCharts & " charts).", vbOKOnly, Descr
Exit Sub
'
'  Error handling area.
'
U_Failure:
MsgBox "Unprotection attempt failed for " & ShtType & ShtName & " so exercise was aborted." & _
       Chr(13) & Chr(13) & _
       Err & ": " & Error(Err), _
       vbOKOnly, Descr
End Sub

 

[MJV8198]

Hi Deniall,

Thank you for the improvement! My work was a copy of the work you and Skip created. To be honest I don't know why I needed to do what I did but I read the errors and copied you work..

It has been a pleasure to work with the both of you.

Michael