Popup box asking for password to unprotect cell

wackyracer8

New Member
Joined
Oct 8, 2015
Messages
5
Hi, I have a excel sheet that is used to calculate staff hours and the sheet is protected with a password to stop people changing it. It has checkboxes and fields which add up/minus etc depending on what is chosen, something that has taken awhile to produce and something I am proud of.

I've got stuck and need some help. What I'd like to do is create a button that says Unlock for example, and when clicked a popup box appears asking for the password. When this is done the text changes to lock and when clicked the sheet is locked again and the wording changes to unlock.

If that is not achievable then I'm happy to have 2 buttons, unlock and lock which work as above.

Any ideas guys?
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).

MoshiM

Active Member
Joined
Jan 31, 2018
Messages
371
Office Version
  1. 2016
Platform
  1. Windows
Hi, I have a excel sheet that is used to calculate staff hours and the sheet is protected with a password to stop people changing it. It has checkboxes and fields which add up/minus etc depending on what is chosen, something that has taken awhile to produce and something I am proud of.

I've got stuck and need some help. What I'd like to do is create a button that says Unlock for example, and when clicked a popup box appears asking for the password. When this is done the text changes to lock and when clicked the sheet is locked again and the wording changes to unlock.

If that is not achievable then I'm happy to have 2 buttons, unlock and lock which work as above.

Any ideas guys?
This is similar to what you want. Edit it so that the password is supplied with an "Application.inputbox" instead of a text file and adjust the stuff within the if statements to do what you want.
Code:
Private Function Worksheet_Protection_Toggle(Optional This_Sheet As Worksheet)

Dim Sheet_Pass As String, filenumber As Long, Path As String, MData As String, D_Str() As String

On Error GoTo 0

    If Environ("USERDOMAIN") = "CAMIL-PC" Then
    
        If This_Sheet Is Nothing Then Set This_Sheet = HUB
    
        If ThisWorkbook.Last_Used_Sheet Is Nothing And This_Sheet Is HUB Then HUB.Range("A4").Select
                
        On Error GoTo No_File_FOUND
            
        If ThisWorkbook.Password_M = "" Then 'password is stored in a text file
            
            Path = Environ("ONEDRIVE") & "\C-Password.txt"
            
            filenumber = FreeFile
            
            Open Path For Input As [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenumber]#filenumber[/URL] 
            
            MData = Input(LOF(filenumber), [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenumber]#filenumber[/URL] )
            
            D_Str = Split(MData, Chr(44))'file is delimted with a comma
            
            ThisWorkbook.Password_M = D_Str(0)
            
            Close [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=filenumber]#filenumber[/URL] 
                
        End If
        
        On Error GoTo Error_While_Locking
 
        With This_Sheet
  
            If .ProtectContents = True Then
            
                .Unprotect ThisWorkbook.Password_M
                
                If This_Sheet Is HUB Then
                    .Shapes("My_Date").Fill.ForeColor.RGB = RGB(51, 102, 0)
                    .Shapes("My_Date_ICE").Fill.ForeColor.RGB = RGB(51, 102, 0)
                End If
                
            Else 'IF it is not protected then protect the sheet
                    
                 If This_Sheet Is HUB Then
                    .Shapes("My_Date").Fill.ForeColor.RGB = RGB(0, 0, 0)
                    .Shapes("My_Date_ICE").Fill.ForeColor.RGB = RGB(0, 0, 0)
                End If
                
                .Protect ThisWorkbook.Password_M, True, True, True, False, True, True, True, False, False, True, False, False, True, True, True

            End If
        
        End With

    End If
    
Exit Function
Error_While_Locking:
    MsgBox This_Sheet.Name & " could not be locked"
    Exit Function

No_File_FOUND:
    MsgBox "Password File not found in OneDrive folder. Worksheets were not locked. If Password has been forgotten check DropBox or Onedrive."
End Function
 

Watch MrExcel Video

Forum statistics

Threads
1,132,914
Messages
5,655,935
Members
418,253
Latest member
TheJackal26

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