VBA to protect multiple worksheets at once and allow users to select protected cells

[lucy61176]

I have the following VBA code to protect multiple worksheets at once and allow users certain editing capabilities for unprotected cells, but I also want them to be able to select protected cells, just not edit them. What code do I need for this? TIA

Sub ProtectAll()
Dim wSheet As Worksheet
Dim Pwd As String
Pwd = InputBox("Enter your password to protect all worksheets", "Password Input")
For Each wSheet In Worksheets
wSheet.Protect Password:=Pwd, DrawingObjects:=False, Contents:=True, Scenarios:=False, _
AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False, _
AllowInsertingColumns:=False, AllowInsertingRows :=False, AllowInsertingHyperlinks:=True, _
AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True
Next wSheet
End Sub

 

[steve the fish]

By default you can select protected cells just cant change them.

 

[dmt32]

Hi,
you can use the EnableSelection property of the worksheet - this property sets what can be selected on the sheet

see if this update to your code does what you want

Sub ProtectAll()
    Dim wSheet      As Worksheet
    Dim Pwd         As String
   
    Pwd = InputBox("Enter your password To protect all worksheets", "Password Input")
    'cancel pressed
    If StrPtr(Pwd) = 0 Then Exit Sub
   
    For Each wSheet In Worksheets
        With wSheet
            .EnableSelection = xlNoRestrictions
            .Protect Password:=Pwd, DrawingObjects:=False, Contents:=True, Scenarios:=False, _
                     AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False, _
                     AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=True, _
                     AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, _
                     AllowUsingPivotTables:=True
        End With
       
    Next wSheet
End Sub

I also added some code to manage the InputBox Cancel button being pressed.

Dave

 

[lucy61176]

Hi,
you can use the EnableSelection property of the worksheet - this property sets what can be selected on the sheet

see if this update to your code does what you want

Sub ProtectAll()
    Dim wSheet      As Worksheet
    Dim Pwd         As String
  
    Pwd = InputBox("Enter your password To protect all worksheets", "Password Input")
    'cancel pressed
    If StrPtr(Pwd) = 0 Then Exit Sub
  
    For Each wSheet In Worksheets
        With wSheet
            .EnableSelection = xlNoRestrictions
            .Protect Password:=Pwd, DrawingObjects:=False, Contents:=True, Scenarios:=False, _
                     AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False, _
                     AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=True, _
                     AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, _
                     AllowUsingPivotTables:=True
        End With
      
    Next wSheet
End Sub

I also added some code to manage the InputBox Cancel button being pressed.

Dave

Thanks so much, Dave! This is exactly what I wanted.

 

[dmt32]

Thanks so much, Dave! This is exactly what I wanted.

most welcome glad we could help & appreciate your feedback

Dave

 

[Msgjazz]

Hi,
you can use the EnableSelection property of the worksheet - this property sets what can be selected on the sheet

see if this update to your code does what you want

Sub ProtectAll()
    Dim wSheet      As Worksheet
    Dim Pwd         As String
  
    Pwd = InputBox("Enter your password To protect all worksheets", "Password Input")
    'cancel pressed
    If StrPtr(Pwd) = 0 Then Exit Sub
  
    For Each wSheet In Worksheets
        With wSheet
            .EnableSelection = xlNoRestrictions
            .Protect Password:=Pwd, DrawingObjects:=False, Contents:=True, Scenarios:=False, _
                     AllowFormattingCells:=True, AllowFormattingColumns:=False, AllowFormattingRows:=False, _
                     AllowInsertingColumns:=False, AllowInsertingRows:=False, AllowInsertingHyperlinks:=True, _
                     AllowDeletingColumns:=False, AllowDeletingRows:=False, AllowSorting:=True, AllowFiltering:=True, _
                     AllowUsingPivotTables:=True
        End With
      
    Next wSheet
End Sub

I also added some code to manage the InputBox Cancel button being pressed.

Dave

I too am having the issue. This is my script:

Sub ProtectAll()
'
' Protect Macro
'
'
'Step 1: Declare your variables
Dim ws As Worksheet

'Step 2: Start looping through all worksheets
For Each ws In ActiveWorkbook.Worksheets

'Step 3: Loop to next worksheet
ws.Protect Password:="*****"


Next ws

' For c = 1 To Sheets.Count
' With Worksheets(c)
' .Protect Password:="*****", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True

' End With
'Next c
End Sub

I tried your submission, but it didn't work for me. Is there something in the beginning of the script that is preventing the script to work right?