Excel Locked Cell Dialog Box

[PCX]

When you protect a sheet and then the user trys to change the cell a dialog box pops up telling them the sheet is protected.

Is there a way to cause my custom dialog box to pop up instead?

I would like to have a custom box come up and ask the user to enter their name before proceeding and then automatically unlock the cells for modification.

Thanks,
Dave

 

[tomschafer]

Unfortunately you the system dialog box cancels out the OnChange event but you can use a SelectionChange event. Paste the following code into the VBA portion of the sheet you wish to use this on more than one sheet let me know and I'll convert it into a more dynamic function for you. Note- change the blue to the existing password of the sheet and the green to the password you want to be entered (both are case sensitive)....

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

If ActiveCell.Locked = True And ActiveSheet.ProtectContents = True Then
If InputBox("What Is The Password?", "Enter Password&quot = "BoxPassword" Then
ActiveSheet.Unprotect ("SheetPassword&quot
Else
MsgBox "Invalid Password", vbOKOnly
End If
End If

End Sub

 

[PCX]

Your example worked perfectly. I would like for the user to enter his or her name and then a password if possible. And they will be using it to unlock a workbook and not just one sheet.

Do you have other suggestions on how to accomplish this?

Thanks again.

 

[tomschafer]

I don't do alot of protection in Excel but this is what I believe. You are not going to the Tools, Protection, Protect Workbook menu are you. That only protects the workbook from having sheets added/removed or protects the size of the window. What I believe you are doing is going to the Tools, Protection, Protect Sheet for each sheet in the workbook, to protect formulas/values. If those assumptions are correct paste this code into the ThisWorkbook module and remove the previous code from the worksheet module. This code assumes you use the same Password for each Sheet which will be reset when the WorkBook is closed. Also while in the VBA explorer I would right click on VBAProject(WorkbookName.xls), goto VBAProject Properties, click the Protection tab, then check the Lock project for viewing box and fill in the password boxes. This will keep an informed user from seeing the code and thus getting the password.

Const conSheetPW As String = "SheetPassword"

Private Sub Workbook_BeforeClose(Cancel As Boolean)

Dim shtSheet As Worksheet

For Each shtSheet In Me.Worksheets
shtSheet.Protect conSheetPW
Next shtSheet

End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Dim strPW As String
Dim strUser As String

If ActiveCell.Locked = True And ActiveSheet.ProtectContents = True Then
strUser = InputBox("What Is Your UserName?", "Enter Name&quot
If strUser = "UserName1" Or strUser = "UserName2" Then
If InputBox("What Is The Password?", "Enter Password&quot = "BoxPassword" Then
ActiveSheet.Unprotect (conSheetPW)
Else
MsgBox "Invalid Password", vbOKOnly
End If
Else
MsgBox "Invalid UserName", vbOKOnly
End If
End If

End Sub


I only added 2 usernames in the example but you just keep repeating (Or strUser = "UserName2&quot for each username you want.

 

[PCX]

Great, it worked very well. Thank you

Sometimes I noticed it does not unprotect the sheet when it is not renamed to something other than "Sheet1" but I will debug that. Should be easy to find.

I made a couple of changes to accomodate multiple users with multiple passwords. (one draw back with my mod. is ANY valid password works so I will have to look for a way around that)

I really appreciate this...

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Excel.Range)

Dim strPW As String
Dim strUser As String

If ActiveCell.Locked = True And ActiveSheet.ProtectContents = True Then
strUser =InputBox("What Is Your UserName?", "Enter Name&quot
strPwd =InputBox("What Is The Password?", "Enter Password&quot

If strUser = "John" Or strUser = "Mark" Then
If strPwd = "pack" Then
ActiveSheet.Unprotect (conSheetPW)
Else
If strPwd = "dood" Then
ActiveSheet.Unprotect (conSheetPW)
Else

MsgBox "Invalid Password", vbOKOnly

End If

End If
Else
MsgBox "Invalid UserName", vbOKOnly
End If
End If

End Sub