Existing macro to password protect sheets has stopped working

[purplekombi]

Hi all,
I'm hoping someone can help me troubleshoot why a macro that has been in use for >4 years without any issues and hasn’t had any recent changes to the coding, has stopped working for some users while still working for me.

The main purpose of the macro is to password protect each sheet while allowing the ability to collapse & expand grouped rows/columns. It’s my understanding that the UserInterfaceOnly:=True code needs to be re-run each time the file is opened for this to work, which is why I’m using the Workbook_Open() sub.

How protection in my file works:
- I have a very hidden ‘Template Info’ sheet with all of my development info. ‘Template Info’!C1 has some dummy text and ‘Template Info’!A1 references cell C1, then cell A1 of all remaining sheets reference ‘Template Info’!A1
- The macro runs through each sheet in the workbook. If cell A1 on any sheet matches the dummy text in ‘Template Info’!C1, then protection gets applied
- This method allows users to insert new sheets that won’t be protected, and allows me to unlock a single sheet for a user by deleting the reference in cell A1 of that sheet, or unlock the whole file by deleting the reference in ‘Template Info’!A1

When I open the file on my computer, the macro runs and the protection is applied. When the file is opened by other users, they get a Run-time 1004 error: "Method 'Protect' of object '_Worksheet' failed"

If I try to debug the run-time error, the macro stops at the "sht.Protect Password:=TemplatePassword, UserInterfaceOnly:=True" line and I get an "Application-defined or object-defined error" and none of the worksheets are protected:

Private Sub Workbook_Open()
'Purpose: Allow outline functionality on password protected sheets
Dim TemplateSheetCheck As String
Dim TemplatePassword As String
Dim sht As Worksheet
 
TemplateSheetCheck = Worksheets("Template Info").Range("C1")
TemplatePassword = Worksheets("Template Info").Range("E8")
 
'Loop through each Worksheet in ActiveWorkbook
  For Each sht In ActiveWorkbook.Worksheets
    
    'Checks whether current sheet is a template sheet
      If sht.Range("A1") = TemplateSheetCheck Then
        'Password Protect Current Sheet
          sht.Protect Password:=TemplatePassword, UserInterfaceOnly:=True
    
        'Enable Group Collapse/Expand Capabilities
          sht.EnableOutlining = True
            
      Else: sht.Unprotect Password:=TemplatePassword
            
      End If
  Next sht
End Sub

Does anyone have any ideas on how to fix this code so that it works for all users?

 

[Fluff]

Welcome to the MrExcel Message Board!

Cross-posting (posting the same question in more than one forum) is not against our rules, but the method of doing so is covered by #13 of the Forum Rules.

Be sure to follow & read the link at the end of the rule too!

Cross posted at: Existing macro to password protect sheets has stopped working
There is no need to repeat the link(s) provided above but if you have posted the question at other places, please provide links to those as well.

If you do cross-post in the future and also provide links, then there shouldn’t be a problem.

 

[purplekombi]

Apologies for not following the cross-posting method, and thank you for showing me the rules.

Someone has tweaked my code and found a solution for me:

Private Sub Workbook_Open()
'Purpose: Allow outline functionality on password protected sheets
    Dim TemplateSheetCheck As String
    Dim TemplatePassword As String
    Dim sht As Worksheet
    
    'added Template as CodeName
    Template.Visible = xlSheetVeryHidden
    
    TemplateSheetCheck = Template.Range("C1")
    TemplatePassword = Template.Range("E8")
    
    'Loop through each Worksheet in ActiveWorkbook
    For Each sht In ThisWorkbook.Worksheets
        
        
        If sht Is Template Then GoTo NextWS
        
        With sht
            .Unprotect Password:=TemplatePassword
            
            'Checks whether current sheet is a template sheet
            If .Range("A1") = TemplateSheetCheck Then
                'Password Protect Current Sheet
                .Protect Password:=TemplatePassword, UserInterfaceOnly:=True
            
                'Enable Group Collapse/Expand Capabilities
                .EnableOutlining = True
            End If
        End With


NextWS:
    Next sht
End Sub