VBA Code to unlock and lock to allow code to update

[Bob Rowley]

Hi Hope someone can help, I have had some code that works perfectly with windows excel 2003 but the code fails in excel any later versions, and suggestions would be very gratefully received.


Option Explicit


Private Sub Workbook_Open()
Dim wSht As Worksheet
Dim PW As String

PW = "mypassword"
'set protection using UserInterface to allow macros to work
For Each wSht In ActiveWorkbook.Sheets
wSht.Protect _
Password:=PW, _
DrawingObjects:=True, _
Contents:=True, _
Scenarios:=True, _
UserInterfaceOnly:=True
Next wSht
End Sub

 

[Yongle]

Your code works perfectly in Excel 365 and protects every sheet in the workbook
In what way does your code not work?

This does the same as your code, using a constant to hold the password, also use of Me to refer to the workbook

Private Sub Workbook_Open()
    Const PW = "mypassword"
    Dim wSht As Worksheet
    For Each wSht In [COLOR=#ff0000]Me[/COLOR].Sheets
        wSht.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    Next wSht
End Sub

and this unprotects every sheet - Use ThisWorkbook if in standard module

Sub UnProt()
    Const PW = "mypassword"
    Dim wSht As Worksheet
    
    For Each wSht In [COLOR=#ff0000]ThisWorkbook[/COLOR].Sheets
        wSht.Unprotect Password:=PW
    Next wSht
End Sub

 

[Bob Rowley]

I open the spreadsheet that was developed in excel 2000 and the code works well, but if I open it in 365 I first get 1004 error message, but the spreadsheet opens but when I click the button on the Calculation page, after entering the variables, the macro cannot run as the sheet cannot update, the code cannot update the sheets, due to lack of password.
I make no other changes, so I cannot understand why it will no longer work, its like a life's work down the drain due to Microsoft making incompatible changes.

Thanks all the same, leave it at that.

 

[Fluff]

Have you tried the changes made by Yongle?
If so & you still get the error, what is the error message & what line is highlighted when you click Debug?

 

[Yongle]

Thanks all the same, leave it at that

That is your choice but you have not moved forward - why bother asking the question?

The problem is NOT in the code you provided - that works perfectly

The problem is in the code that does this : "when I click the button on the Calculation page, after entering the variables, the macro cannot run as the sheet cannot update, the code cannot update the sheets, due to lack of password"

If you want to solve your problem please post that code

 

[Bob Rowley]

Thanks Yongle, I know its to do with the password, if I manually unlock each sheet (28 of them) prior the code runs, with the password in place when checking debugging the first line in the code is always the first line of code that needs to make a change to the sheet.
if I unlock in the order of the code calls, I can get through to an eventual full run through to successful completion.

Ill try your code but was wondering does it replace the password once the macro completes.

I forgot to mention that I sometimes get a runtime error code 13, type mismatch when I first open the Spreadsheet, I am not sure how relevant this is?

 

[Yongle]

I forgot to mention that I sometimes get a runtime error code 13, type mismatch when I first open the Spreadsheet, I am not sure how relevant this is?

That could be because you are using ActiveWorkbook which is "uupredictable" if you have more than one workbook open at the same time (or it may be due to something else entirely )
Try my version of Workbook_Open and see if that resolves your issue

wondering does it replace the password once the macro completes

After you have resolved your problem

Sub YourOtherMacro()
    Call UnProt
    [COLOR=#ff0000]Your code doing whatever you want goes here[/COLOR]
    Call ReProt
End Sub

In STANDARD module

Sub [COLOR=#ff0000]ReProt[/COLOR]()
    Const PW = "mypassword"
    Dim wSht As Worksheet
    For Each wSht In ThisWorkbook.Sheets
        wSht.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True, UserInterfaceOnly:=True
    Next wSht
End Sub

Sub [COLOR=#ff0000]UnProt[/COLOR]()
    Const PW = "mypassword"
    Dim wSht As Worksheet    
    For Each wSht In ThisWorkbook.Sheets
        wSht.Unprotect Password:=PW
    Next wSht
End Sub

And also amend Workbook_Open

Private Sub Workbook_Open()
    Call ReProt
End Sub

 

[Bob Rowley]

That could be because you are using ActiveWorkbook which is "uupredictable" if you have more than one workbook open at the same time (or it may be due to something else entirely )
Try my version of Workbook_Open and see if that resolves your issue


==============================================
Hi Yongle, thanks for trying to help me, I managed to run each prot and unprot macros manually and the SHUTMAN macro works when I do that, but when I try to automate it by placing the calls in the main macro it does not work, below is the top few lines of code, where do I place the code that you did for me?

Sub Module1()
Call UnProt
​

I have tried putting the call as the first line in SHUTMAN but it does not unprot​

Call ReProt
End Sub​

Below is first lines of my main SHUTMAN macro code


Private Const cstrModule As String = "Shutman"


Public Sub Findtube() 'finds tube, motor, torque/s
Dim lath_pitch, lath_weight, thick, lathcost As Double
Dim coiling As String 'Variant
Dim Lathtype As String 'Variant
Dim columnA As String 'Variant
Set WB = ThisWorkbook.Sheets("CalcSheet") 'sets workbook
Let coiling = WB.Range("coiling").Value
Let Lathtype = WB.Range("Lathtype").Value


Sorry for the delay in reply but I gave it a rest last week, as it was getting me down, also no matter what I try I am still getting the error code 13 and this is even before Excel 365 opens, so is not spreadsheet related.

Regards

Bob