Unprotect sheet for certain users upon start up

[mkuznetsov1]

VBA Newbie here...I am trying to write a code under the workbook so when a sheet opens it is unprotected to "admin" users...the kicker is I want it set up based on my second sheet "AuthUsers" in column A where the admins are allowed to edit/add new users. (usernames are system not excel). I was trying to mimic this code I used for the read only code but have no luck. I have been trying different things in the module and running it from there to see if it will unprotect with my username filled in but no luck. I will post the base read only code and then what I have tried to do with it. Any help would be awesome!


'This sets all users to read only unless you are listed in AuthUsers sheet column A
Users = Environ("USERNAME")
Set C = Worksheets("AuthUsers").Range("A1:A100").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If C Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
'may already be read only
If ThisWorkbook.Path <> vbNullString Then ThisWorkbook.ChangeFileAccess xlReadOnly
On Error GoTo 0
Application.DisplayAlerts = True
End If
Users = Environ("USERNAME")
Set C = Worksheets("AuthUsers").Range("A3").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If C Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
'may already be read only
If C = Environ("USERNAME") Then Sheets("EDP #s").Unprotect (Pass)
On Error GoTo 0
Application.DisplayAlerts = True
End If

[georgiboy]

Welcome to the forum mkuznetsov1,

Try the below in the sheet 'EDP #s', the code needs to go in that sheets code window:


Private Sub Worksheet_Activate()
Dim Users As String, c As Range, pass As String

Users = Environ("USERNAME")
Set c = Worksheets("AuthUsers").Range("A1:A100").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
pass = "password"

If c Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
'may already be read only
If ThisWorkbook.Path <> vbNullString Then
ThisWorkbook.ChangeFileAccess xlReadOnly
Me.Protect pass
End If
On Error GoTo 0
Application.DisplayAlerts = True
Else
Application.DisplayAlerts = False
On Error Resume Next
'may already be read only
If c = Users Then Me.Unprotect pass
On Error GoTo 0
Application.DisplayAlerts = True
End If
End Sub

[mkuznetsov1]

Hey Georgiboy....

I ended up getting it after a lot of trial and error right before you replied..This is the code that works for me.


'This sets all users to read only unless you are listed in AuthUsers sheet column A
Users = Environ("USERNAME")
Set C = Worksheets("AuthUsers").Range("A1:A1000").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If C Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
'may already be read only
If ThisWorkbook.Path <> vbNullString Then ThisWorkbook.ChangeFileAccess xlReadOnly
On Error GoTo 0
Application.DisplayAlerts = True
End If
'This sets all users to protected mode unless in Admin Cell A3:A6
ThisWorkbook.Worksheets("EDP #s").Unprotect (Pass)
Users = Environ("USERNAME")
Set C = Worksheets("AuthUsers").Range("A3:A6").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If C Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> vbNullString Then ThisWorkbook.Worksheets("EDP #S").Protect (Pass)
On Error GoTo 0
Application.DisplayAlerts = True
End If
'This shows the AuthUsers Sheet to Admin users and hides to everyone else.
Users = Environ("USERNAME")
Set C = Worksheets("AuthUsers").Range("A3:A6").Find(Users, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If C Is Nothing Then
Application.DisplayAlerts = False
On Error Resume Next
If ThisWorkbook.Path <> vbNullString Then ThisWorkbook.Worksheets("AuthUsers").Visible = False
On Error GoTo 0
Application.DisplayAlerts = True
End If

Thank you for the help!