Sunday, October 24, 2004

Protect and Unprotect Sheets Macro

I use some quick easy VBA code to protect and unprotect sheets. I will give you the two versions I use.

The first one is used where the password is obviously shown in the macro. The second "hides" the password. It doesn't really hide it but it is in a different spot and makes it less likely that users will find the password. Of course any users who really wanted to bypass the screen door protection of the Excel passwords would use the all internal passwords code I posted previously.

Simply copy and paste the text below into a module in the VBA editor.
You will need to ensure that all the sheets are either completely unlocked first or are all locked with the same password you use in the macro. This will work on hidden sheets also.

Visible password code
Copy this line into any module you like. Change the password in the quote marks to your required password.

Sub protect()
'protect macro
' Macro written by Jethro Management
Application.ScreenUpdating = False
For Each ws In Sheets
ws.protect Password:="expword"
Next ws
Application.ScreenUpdating = True
End Sub

Sub unprotect()
'unprotect macro
' Macro written by Jethro Management
Application.ScreenUpdating = False
For Each ws In Sheets
ws.unprotect Password:="expword"
Next ws
Application.ScreenUpdating = True
End Sub


Code with password stored as a Public Constant elsewhere

Copy this line into any module you like. Change the password in the quote marks to your required password.
Public Const expword As String = "expass"


The remainder of the code can go in any module also - doesnt have to be the same module that the password constant declaration is in.

Sub protect()
'protect macro
' Macro written by Jethro Management
Application.ScreenUpdating = False
For Each ws In Sheets
ws.protect Password:=expword
Next ws
Application.ScreenUpdating = True
End Sub

Sub unprotect()
'unprotect macro
' Macro written by Jethro Management
Application.ScreenUpdating = False
For Each ws In Sheets
ws.unprotect Password:=expword
Next ws
Application.ScreenUpdating = True
End Sub


If you need help then email me using the link on the right.


Posted by: Jethro | 11:29 PM |