This would require VBA. I'm just beginning to learn VBA but here's what I came up with. You will need to secure your VBA code to prevent people from looking at the code where other people's passwords will be seen. One of the VBA gurus here might improve on this code. You''ll need a subroutine that runs on opening the workbook (to unprotect specific columns) and one to work on saving (to reprotect those columns). These routines should be pasted in "Thisworkbook". Right click on a tab and "view code" to open the vba editor and then double click on thisworkbook to open that code window. In my example, I did not protect the code so you can view it.
I chose Jim, Lynn, and Bob with passwords JimsPassword, LynnsPassword and BobsPassword. The sheet password is "test_one"
Routine 1
Private Sub Workbook_Open()
Dim UserName As String
Dim Pword As String
Dim Qualifier As String
Sheets("Sheet1").Select
Application.ScreenUpdating = False
UserName = InputBox("Enter your name")
Qualifier = InputBox("Enter your password")
Select Case UserName
Case "Jim"
If Qualifier = "JimsPassword" Then 'Replace with Jim's log in password
ActiveSheet.Unprotect Password:="test_one" 'Replace with the worksheet password
Columns("A:B").Select
Selection.Locked = False
[A1].Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test_one" 'Replace with the worksheet password
Else
MsgBox ("That is the incorrect password. Close the book and try again")
End If
Case "Lynn"
If Qualifier = "LynnsPassword" Then 'Replace with Lynn's log in password
ActiveSheet.Unprotect Password:="test_one" 'Replace with the worksheet password
Columns("C:D").Select
Selection.Locked = False
[A1].Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test_one"
Else
MsgBox ("That is the incorrect password. Close the book and try again")
End If
Case "Bob"
If Qualifier = "BobsPassword" Then 'Replace with Bob's log in password
ActiveSheet.Unprotect Password:="test_one"
Columns("E:F").Select
Selection.Locked = False
[A1].Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test_one"
Else
MsgBox ("That is the incorrect password. Close the book and try again")
End If
Case Else
MsgBox ("You have view only rights to this spreadsheet")
End Select
Application.ScreenUpdating = True
End Sub
Routine 2 (for saving) much shorter.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
ActiveSheet.Unprotect Password:="test_one"
Columns("A:F").Select
Selection.Locked = True
[A1].Select
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="test_one"
End Sub
Bookmarks