Worksheet VBA password protect - including autofilter

[eddster]

Hi All,

I have a VBA code i am using to password protect a document with multiple (50+) input worksheets and sensitive formulas

The code i have (found online) input as a module is as below however i also need the users to be able to use autofilter where i have a filter bar included and possibly be able to edit the cell width height coum etc. Obviosuly i can do this using the worksheet password protect and choosing the options in the check boxes but this takes an awfully long time and RSI with so manys sheet. Any assistance willfully accepted. Thanks. Edd

Sub protect_all_sheets()
top:
pass = InputBox("password?")
repass = InputBox("Verify Password")
If Not (pass = repass) Then
MsgBox "you made a boo boo"
GoTo top
End If
For i = 1 To Worksheets.Count
If Worksheets(i).ProtectContents = True Then GoTo oops
Next
For Each s In ActiveWorkbook.Worksheets
s.Protect Password:=pass
Next
Exit Sub
oops: MsgBox "I think you have some sheets that arealready protected. Please unprotect all sheets then running this Macro."
End Sub

 

[dmt32]

Hi,
you can apply the protection checkbox options (parameters) in code

try this update to your code

Sub protect_all_sheets()
    Dim pass(1 To 2) As Variant
    Dim i As Integer
    
    Do
        i = i + 1
        pass(i) = InputBox("Enter Password?", "Password")
'cancel pressed
        If StrPtr(pass(i)) = 0 Then Exit Sub
'confirm password match
        If i = 2 And Not (pass(1) = pass(2)) Then
            MsgBox "you made a boo boo", 16, "Passwords Do Not Match"
            i = 0
        End If
    Loop Until i = 2
    
    On Error GoTo oops
    For i = 1 To Worksheets.Count
        With Worksheets(i)
'if sheet already protected, check if same password was used
            If .ProtectContents = True Then .Unprotect Password:=pass(2)
'apply protection with required parameters
            .Protect Password:=pass(2), AllowFiltering:=True, AllowFormattingCells:=True
        End With
    Next


oops:
If Err <> 0 Then
'if different password used inform user
    MsgBox Worksheets(i).Name & " is already protected with another password." & Chr(10) & _
    "Please unprotect all sheets then run this Macro.", 48, "Sheet Already Protected"
End If
End Sub

I have included a couple of the available parameters but you can find full list here:https://docs.microsoft.com/en-us/office/vba/api/excel.worksheet.protect

Updated code will first test any protected sheet to ensure it was protected with same password - if not same password then your message will show & code terminate otherwise code continues.

Hope helpful

Dave

 

[eddster]

Excellent thank you Dave that works beautifully!

Is there another Macro module I can run in conjunction with this one so that I can unprotect all the worksheets in one go (using the password I set to protect the sheets).

regards

Edd

 

[dmt32]

Excellent thank you Dave that works beautifully!

Is there another Macro module I can run in conjunction with this one so that I can unprotect all the worksheets in one go (using the password I set to protect the sheets).

regards

Edd

Hi,
use existing code to perform both operations just modified a little

Sub protect_all_sheets(Optional ByVal ProtectSheets As Boolean)
    Dim pass(1 To 2) As Variant
    Dim i As Integer
    
    Do
        i = i + 1
        pass(i) = InputBox("Enter Password?", "Password")
'cancel pressed


        If StrPtr(pass(i)) = 0 Then Exit Sub
'confirm password match
        If i = 2 And Not (pass(1) = pass(2)) Then
            MsgBox "you made a boo boo", 16, "Passwords Do Not Match"
            i = 0
        End If
    Loop Until i = 2
    
    On Error GoTo oops
    For i = 1 To Worksheets.Count
        With Worksheets(i)
'if sheet already protected, check if same password was used
            If .ProtectContents = True Then .Unprotect Password:=pass(2)
'apply protection with required parameters
        If ProtectSheets Then .Protect Password:=pass(2), AllowFiltering:=True, AllowFormattingCells:=True
        End With
    Next


oops:
If Err <> 0 Then
'if different password used inform user
 If ProtectSheets Then
    MsgBox Worksheets(i).Name & " is already protected with another password." & Chr(10) & _
    "Please unprotect all sheets then run this Macro.", 48, "Sheet Already Protected"
 Else
    MsgBox (Error(Err)), 48, "Error"
 End If
End If
End Sub

updates not tested but you call your code, just add argument True to protect sheets or False (default) to unprotect

  protect_all_sheets True

to unprotect

  protect_all_sheets False

you can omit the argument if want to as parameter default is false.

Dave