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

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

MoshiM

Active Member
Joined
Jan 31, 2018
Messages
407
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
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,167,153
Messages
5,852,413
Members
431,506
Latest member
gogstbill

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