Prompt for Password when Protecting a sheet

Justplainj

New Member
Joined
Apr 15, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hi All.

I am using the following code to use a button to protect a sheet.

VBA Code:
Sub ProtectSheetWithPassword()

Dim sh As Worksheet
Set sh = ActiveSheet

sh.Shapes("ProtectBtn").Visible = msoFalse
sh.Shapes("UnprotectBtn").Visible = msoTrue

'Protect worksheet with a password
ActiveSheet.Protect Password:=Range("A2")

    Range("A2").Select
    Selection.ClearContents

End Sub

I am currently opting for the user to type the password in cell A2 to accept the password.
The unprotect macro is similar but I do not specify a range so that excel automatically uses a pop up where they enter the password.

Question.
How can I edit the above code to use a popup to enter the password when the sheet is being 'Protected', like it does when you unprotect?

Thanks in advance.
JPJ
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

Justplainj

New Member
Joined
Apr 15, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hi,

Just for interest sake. This is the code i use to unprotect the sheet.
I use shaped buttons I created in PPT as a custom toggle button.
Trying to give as much info as possible :)

Just trying to figure out to use the password prompt box instead of the user typing in a cell to password lock the sheet.

VBA Code:
Sub UnProtectSheetWithPassword()

Dim sh As Worksheet, pass As String
Set sh = ActiveSheet

sh.Shapes("ProtectBtn").Visible = msoTrue
sh.Shapes("UnprotectBtn").Visible = msoFalse

'Unprotect worksheet with a password
On Error GoTo Popup:
ActiveSheet.Unprotect


Range("A2").Select
Selection.ClearContents

Exit Sub
Popup:
If Err.Number = 1004 Then

sh.Shapes("ProtectBtn").Visible = msoFalse
sh.Shapes("UnprotectBtn").Visible = msoTrue

Range("A2").Select
Selection.ClearContents

MsgBox "Incorrect Password"

End If
 

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,072
You could get the password from an InputBox rather than the Protect dialog.

VBA Code:
Dim uiPW as String

uiPW = Application.InputBox("Password please", type:=2)
If uiPW = "False" Then Exit Sub: Rem cancel pressed

ActiveSheet.Protect Password:=uiPW
There could be alterations to force the user to enter the password twice or to force a non "" password. (Was it Gosper or Goldblatt who advised MIT professors to all use "" as their password?)
 
Solution

Justplainj

New Member
Joined
Apr 15, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Thank you mikerickson.
Works perfectly.

You did peak my interest though with.
There could be alterations to force the user to enter the password twice or to force a non "" password.
:)
 

Justplainj

New Member
Joined
Apr 15, 2021
Messages
13
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

HI,

I came up with this in the end to force entering the password twice and not to have blank password

VBA Code:
Sub ProtectSheetWithPassword()

Dim sh As Worksheet
Dim uiPW1 As String
Dim uiPW2 As String
Set sh = ActiveSheet

sh.Shapes("ProtectBtn").Visible = msoFalse
sh.Shapes("UnprotectBtn").Visible = msoTrue

'Protect worksheet with a password
uiPW1 = Application.InputBox("Please enter password", Type:=2)
uiPW2 = Application.InputBox("Please enter password again", Type:=2)

If uiPW1 = "" Then
    sh.Shapes("ProtectBtn").Visible = msoTrue
    sh.Shapes("UnprotectBtn").Visible = msoFalse
    MsgBox "Password cannot be blank"
Else
sh.Shapes("ProtectBtn").Visible = msoTrue
sh.Shapes("UnprotectBtn").Visible = msoFalse

    If uiPW1 = uiPW2 Then
        If uiPW1 = "False" Then Exit Sub: Rem cancel pressed
        ActiveSheet.Protect Password:=uiPW1, DrawingObjects:=True, Contents:=True, Scenarios:=True

        Range("A2").Select
        Selection.ClearContents
        Range("A1") = "Click Unprotect WS to edit sheet"

        MsgBox "The sheet is Protected and cannot be edited"
    Else

    MsgBox "Password does not match, Please retry"

    End If

End If
   
End Sub
 
Last edited:

mikerickson

MrExcel MVP
Joined
Jan 15, 2007
Messages
24,072
For the two pass password entry
VBA Code:
Dim uiPW1 as String, uiPW2 as String

Do
    uiPW1 = InputBox("Password please", type:=2)
    If uiPW1 = "False" Then Exit Sub
    uiPW2 = InputBox("Retype password", type:=2
    If uiPW2 = "False" Then Exit Sub
    If uiPW1 <> uiPW2 Then
        If MsgBox("Password mismatch. Try again.", vbOKCancel) = vbCancel Then Exit Sub
    End If
Loop until uiPW1=uiPW2
ActiveSheet.Protect Password:=uiPW1
 

Forum statistics

Threads
1,141,773
Messages
5,708,453
Members
421,570
Latest member
BaileyJ

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top