If you have a large list of users you may need to load the Access PassWords into an Array Or use the "Select Case" structure rather than the "IF" structure below!.
The code below will work if you have a limited number of users.
On each of the sheets only Cell: A1 will allow data [this is for the users password only!] if the wrong password is entered the sheet will be read only!
To protect the password from view change the Text color to the Cell color!
If a sheet does not have an "IF" statement then, that sheet is, read-only for all users!
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'ThisWorkbook code!
If Sheets("Sheet2").Range("A1") = "User_1PW" Or _
Sheets("Sheet2").Range("A1") = "User_2PW" Then
Sheets("Sheet2").Unprotect
Else
Sheets("Sheet2").Protect
End If
If Sheets("Sheet3").Range("A1") = "User_3PW" Or _
Sheets("Sheet3").Range("A1") = "User_2PW" Then
Sheets("Sheet3").Unprotect
Else
Sheets("Sheet3").Protect
End If
End Sub
If every user is logged into a network then you can add code to get that users name and automatically do this, for them or you can change the Cell A1 trigger to an InputBox or UserForm as well!
This is some sample code to show you how to get Network User Information:
Sub UserNWInfo()
Dim DomainName, ComputerName, UserName
DomainName = Environ("UserDomain")
ComputerName = Environ("ComputerName")
UserName = Environ("UserName")
MsgBox "Network Domain Name: ==> " & DomainName & Chr(13) & _
"Full Comuter Name: ==> " & ComputerName & Chr(13) & _
"User Name: ==> " & UserName
'Show User Name!
If Application.UserName = "" Then GoTo NoNam Else GoTo HNam
End
NoNam:
'User name not in system.
'Get User Name as input.
UNText = Application.InputBox( _
prompt:="The user: " & UserName & " has not indicated their name," & Chr(13) & _
"in the Tools-Options-General, User Name: box of Excel." & _
Chr(13) & "Or the network system User Name was not found?" & _
Chr(13) & Chr(13) & _
"Please enter the User Name here:" & Chr(13) & Chr(13) & _
"Note: This will not change the User Name in Options!", _
Title:="User Name not installed on this PC!")
HNam:
MsgBox "Environment User Name: " & Environ("username") & Chr(13) & _
Chr(13) & "Application User Name: " & Application.UserName
End Sub
