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?

[GTO]

Greetings purplekombi and welcome to VBAExpress :),

Reference 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

I am likely being thick headed, but not quite following. Could you attach the workbook, or a same design/code example workbook scrubbed of any sensitive data?

Mark

[purplekombi]

Hi Mark,

I've attached an example file explaining which sheets are locked/unlocked by the macro. Essentially, the macro runs through each sheet and if A1 matches C1 of the Template Info sheet it will be locked, otherwise it is unlocked.

30896
30896

Cheers,
purplekombi

[purplekombi]

Apologies - I don't know why the file attached twice...

[Paul_Hossler]

I tried various things but it always seems to work for me

I did rearrange code and gave the template a CodeName while I tried different things

You DO know that this approach is not very secure and can be 'cracked' easily?

Might see if the attached version works on other computers. If it does (maybe) it might give you some insight

Possibly, there are different versions of Excel involved?



Option Explicit


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

[purplekombi]

Thank you Paul_Hossler!

I've tested your version of the macro on my computer and 3 of my colleagues' computers and it has so far worked for all of us.

I know this method isn't 100% secure but the purpose of locking these files is simply to prevent people from changing formulas so they are consistent across different projects, and over 5 years I've had maybe one colleague with the type of skills to figure out how to find a very hidden sheet or read a macro.

I hadn't heard of using codenames before and I can see how useful they could be, so thank you again.

Cheers,
purplekombi

[Paul_Hossler]

Thank you Paul_Hossler!

I've tested your version of the macro on my computer and 3 of my colleagues' computers and it has so far worked for all of us.

I hadn't heard of using codenames before and I can see how useful they could be, so thank you again.
purplekombi

Advantage of CodeNames is that if a user (you can never trust them) changes a WS name on the tab, the macro still works since the CodeName is usually left alone