VBA Script to automatically apply Password to Workbook when closing, prompt user for PW when opening and setting to read-only if input incorrect.

[Funkk]

Hello Everyone

Been scouring these forums for a few days before deciding to make my own account... There's been many topics that come extremely close to what I'm looking for, yet none have been the exact same to my knowledge.

So, I'd like for the entire workbook to be Password protected upon closing it, so that every user who opens it must first input the password.
It should preferably pop up in an inputBox. If the user gets the PW right, he can modify the file to his liking.
If he gets it wrong or hits "cancel", he should still be able to look at and copy data from any cell he wants, but he cannot add anything new.

Could you guys maybe help me with that?


What I have so far:

Option Explicit
Private Sub Workbook_Open()
Dim xSheet As Worksheet
Dim xPsw   As String
Dim answer As String
xPsw = "PASSWORD"
answer = InputBox("Input password if you want to unprotect" & vbLf & "all your sheets then press OK.")
If answer = xPsw Then
For Each xSheet In Worksheets
xSheet.Unprotect xPsw
Next
MsgBox "Done!"
End If
End Sub

 

[Jimmypop]

Hi There...

The below will protect all sheets on exit... and can only be unlocked if passwords match...

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
        wsheet.Protect Password:="PASSWORD"
        Next wsheet
    End Sub
    Private Sub Workbook_Open()
        Dim xSheet As Worksheet
        Dim xPsw   As String
        Dim answer As String
        xPsw = "PASSWORD"
        answer = InputBox("Input password if you want to unprotect" & vbLf & "all your sheets then press OK.")
        If answer = xPsw Then
            For Each xSheet In Worksheets
                xSheet.Unprotect xPsw
            Next
            MsgBox "Done!"
            Else
            MsgBox "Wrong Password. Close and re-open to input correct password"
        End If
    End Sub

 

[Funkk]

Hi There...

The below will protect all sheets on exit... and can only be unlocked if passwords match...

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
        wsheet.Protect Password:="PASSWORD"
        Next wsheet
    End Sub
    Private Sub Workbook_Open()
        Dim xSheet As Worksheet
        Dim xPsw   As String
        Dim answer As String
        xPsw = "PASSWORD"
        answer = InputBox("Input password if you want to unprotect" & vbLf & "all your sheets then press OK.")
        If answer = xPsw Then
            For Each xSheet In Worksheets
                xSheet.Unprotect xPsw
            Next
            MsgBox "Done!"
            Else
            MsgBox "Wrong Password. Close and re-open to input correct password"
        End If
    End Sub

Thank you very much, first of all!
I tried applying this code to my Excel file and changed the 2 Password definitions to "test". Sadly, entering "test" into the Password prompt produces a Runtime error '1004'.

Apparently the Password is invalid, but I've changed everything I have to change, right?

Opening the debugger highlights the middle line among the following three:

For Each xSheet In Worksheets
                xSheet.Unprotect xPsw
            Next

Very possible I missed something obvious, I hope I'm not wasting your time with a dumb follow up question.

 

[Jimmypop]

Did you make sure to clear and unprotect all sheets before closing...

So basically make sure all sheets are unprotected before closing the file...

 

[Jimmypop]

Thank you very much, first of all!
I tried applying this code to my Excel file and changed the 2 Password definitions to "test". Sadly, entering "test" into the Password prompt produces a Runtime error '1004'.

Apparently the Password is invalid, but I've changed everything I have to change, right?

Opening the debugger highlights the middle line among the following three:

For Each xSheet In Worksheets
                xSheet.Unprotect xPsw
            Next

Very possible I missed something obvious, I hope I'm not wasting your time with a dumb follow up question.

Good day...

I tested this with chaniging to "test" and it worked perfectly...

I then changed one of my sheets password to something else and left the others unlocked. Closed file and opened again and input the password of "test". It then gave me the error as you said...

So as per my previous post you have a sheet somewhere where it has a different password. Make sure ALL sheets are not protected before closing file...

 

[Funkk]

Good day...

I tested this with chaniging to "test" and it worked perfectly...

I then changed one of my sheets password to something else and left the others unlocked. Closed file and opened again and input the password of "test". It then gave me the error as you said...

So as per my previous post you have a sheet somewhere where it has a different password. Make sure ALL sheets are not protected before closing file...

Good day @Jimmypop

Thanks to your continued assistance, the issue has been resolved and the code now works perfectly, as described.

Thank you for your time! It is greatly appreciated.

Greetings

 

[Jimmypop]

No problem...glad we could help... BTW... how will you be assigning passwords for users?

 

[Bombdiggity]

Hello Everyone,
Thank you for creating this thread! It has been super helpful so far w multiple sheet protections.
I have used the above code successfully with several of my unlinked sheets without encountering any errors at all.
On linked workbooks however, I am encountering a debugging prompt that indicates that the password is incorrect; even when entered correctly.
Does anyone know why this could be? Seems to work perfectly if the sheet contains no links. Could you guys help me with this?

Thank you in advance,

 

[Jimmypop]

Hi There

Somewhere in your workbook/s or sheet/s you have a protected sheet with a password not equal to "7010". My suggestion would be to make sure all your sheets in linked workbooks are not protected (or protect them with "7010"...(then close and save). On closing the one piece of code will lock all sheets of the activeworkbook with the same password, except if they are already protected with a different password, see my Post #5.

You can always add the code below to all linked workbooks to make sure that on them closing that the correct password is assigned. So the most important thing here is to make sure to use the same password everywhere.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim wsheet As Worksheet
    For Each wsheet In ActiveWorkbook.Worksheets
        wsheet.Protect Password:="7010"
        Next wsheet
End Sub

 

[Bombdiggity]

Thank you @Jimmypop
I found the sheet with the incorrect password and was able to solve the problem.
The additional code is great to avoid the same mistake in the future.
Cheers!