VBA Code to unprotect multiple sheets by entering p/w once for sheets that were auto protected

[DianaS]

I created a code to automatically protect multiple sheets in a workbook with a password of my choice but without having to manually enter it. Let's pretend the password = ORANGE. See code below:

Sub ProtectTabs()
Dim ws As Worksheet

Set WSArray = Sheets(Array("Sheet1", "Sheet3", "Sheet5"))
For Each ws In WSArray
ws.Protect password:="ORANGE", DrawingObjects:=True, Contents:=True, Scenarios:=True

Next

End Sub
​

I currently have a code to unprotect it by automatically entering the password (ORANGE)...works great! However, I do not want anyone to automatically unprotecting these sheets. Just those that have the password. I would like to Unprotect these tabs by:

1) having the user enter the correct password (ORANGE) once to unlock all sheets in array
2) If p/w is incorrect having msg "Incorrect Password, Try again" and looping them back to the p/w input
3) Looping a max of 3 times, if unsuccessful then Msg. "See Administrator for help"​

Any help is appreciated.

 

[korhan]

How about this

Option Explicit


Sub ProtectTabs()
    ' Declare constants
    Const CORRECT_PASS As String = "1111"
    
    ' Declare variables
    Dim passwd As String: passwd = Empty
    Dim attempt As Byte: attempt = 1


    Do
        passwd = InputBox("Please, enter the password to unprotect the sheets:", "Password Needed")
            ' If the user hit cancel exit sub
            If Len(passwd) = 0 Then
                Exit Sub
            ElseIf passwd <> CORRECT_PASS Then
                attempt = attempt + 1
                MsgBox "Incorrect message.Try again!"
            ElseIf passwd = CORRECT_PASS Then
                MsgBox "Success!"
                Call UnProtectSheets
                Exit Sub
            End If
    Loop While attempt <= 3
    
    MsgBox "See Admin for help.", vbCritical
    
End Sub
Sub ProtectSheets()
    Dim ws As Worksheet
    Dim wsArray
    Set wsArray = Sheets(Array("Sheet1", "Sheet3", "Sheet5"))
    For Each ws In wsArray
        ws.Protect Password:="ORANGE", DrawingObjects:=True, Contents:=True, Scenarios:=True
    Next
End Sub
Sub UnProtectSheets()
    Dim ws As Worksheet
    Dim wsArray
    Set wsArray = Sheets(Array("Sheet1", "Sheet3", "Sheet5"))
    For Each ws In wsArray
        If ws.ProtectContents = True Then
            ws.Unprotect "ORANGE"
        End If
    Next ws
End Sub

 

[hello123456789]

Hello,

I am new to Excel VBA and came across this code which fits perfectly with what I need. How when I try to input the correct password at the top, it doesn't accept the password and ends up going through the loop.

Are you able to assist with why that might be happening?

 

[Michael M]

Are you trying to Unprotect ALL sheets in the workbook?

Sub UnProtectSheets()
    Dim ws As Worksheet
   For Each ws In Worksheets
        ws.Unprotect "ORANGE"
    Next ws
End Sub

 

[johnnyL]

4 year Old thread ?

 

[Michael M]

@johnnyL
Yeah, I know....but post #3 was todays, so the new OP was looking for an answer !!

 

[johnnyL]

The new OP? Is that a thing?

 

[Michael M]

Yep...the OP in post #3 wasn't the original poster, so had joined later rather than starting a new thread!!