Unprotecting a worksheet by user ID

[DaveA54]

Hi. I'm new to the forum so treat me gently! Can't find anything that quite answers this so...
I have a workbook with half a dozen worksheets. One of the worksheets contains master data that the others call on. Only a small group of people need to be able to change the master data but everyone needs to be able to see it.
Is it possible to unlock the master worksheet for those that need to amend it based on their user ID, but leave it locked for everyone else? Using the standard 'protect worksheet' function is OK except that the users don't always re-protect it once they have finished, which kind of defeats the object.
We are currently using Excel 2003 but will be migrating to 2013 later this year. I need to be able to do this, if possible, from now.
Any advice or assistance would be greatly appreciated.

 

[MARK858]

See if the file in the link attached helps (sorry can't remember who wrote it a long time ago).
The code is in the ThisWorkbook module.
Change the bit in red in the code (see copy of the code below) to the Administrators username.
The file will create a sheet for each user as they open it and so just recycle the same workbook to each user.
Finally remember to protect the code module.


http://app.box.com/s/9xgt1uev2o3vk3a85fu9


Copy of the code...

Option Explicit
Option Compare Text
 
Sub Workbook_BeforeClose(Cancel As Boolean)
 
Dim ws As Worksheet
Dim rep As Integer
 
If ThisWorkbook.Saved = False Then
  rep = MsgBox("You must save this workbook if you want your worksheet to remain hidden." _
      & vbCrLf & vbCrLf _
      & "Do you want to save the changes you made to '" & ThisWorkbook.Name & "'?", vbYesNoCancel)
  If rep = vbCancel Then Cancel = True: Exit Sub
  If rep = vbNo Then ThisWorkbook.Saved = True: ThisWorkbook.Close
End If
 
On Error Resume Next
Sheets("Main").Visible = True
Set ws = Sheets("Main")
On Error GoTo 0
If ws Is Nothing Then Sheets.Add.Name = "Main"
 
For Each ws In Worksheets
  If ws.Name <> "Main" Then ws.Visible = xlVeryHidden
Next ws
 
Sheets("Main").Visible = True
 
ThisWorkbook.Save
 
End Sub

Sub Workbook_Open()
 
Dim ws As Worksheet
Dim reply As Integer
Dim usr As String
 
If Environ("username") = "[COLOR="#FF0000"]MARK858[/COLOR]" Then 'amend to Administrators username
  reply = MsgBox("You are logged in as Administrator" & Space(15) & vbCrLf & vbCrLf _
        & Space(5) & "Click 'Yes' to run the security script" & Space(15) & vbCrLf & vbCrLf _
        & Space(5) & "Click 'No' to display all worksheets" & Space(15), vbYesNo + vbQuestion)
  If reply = vbNo Then
    For Each ws In Worksheets
      ws.Visible = True
    Next ws
    Exit Sub
  End If
End If
 
On Error Resume Next
Sheets("Main").Visible = True
Set ws = Sheets("Main")
On Error GoTo 0
If ws Is Nothing Then Sheets.Add.Name = "Main"
 
For Each ws In Worksheets
  If ws.Name <> "Main" Then ws.Visible = xlVeryHidden
Next ws
 
usr = Environ("username")
On Error Resume Next
Set ws = Sheets(usr)
ws.Visible = True
On Error GoTo 0
If ws Is Nothing Then Sheets.Add.Name = usr
 
Sheets("Main").Visible = xlVeryHidden
 
ThisWorkbook.Saved = True
 
End Sub

 

[dmt32]

Hi welcome to the board.
See if this solution helps you.

Place this code in the Thisworkbook Code page:

Private Sub Workbook_Open()
    Dim Admin As Boolean
 
     'Your master worksheet - change name as required.
    With Worksheets("Master")
 
        If AuthorizedUser(User:=Environ("USERNAME"), Admin:=Admin) Then
 
            .Unprotect Password:="YourPasswordHere"
 
            If Admin Then Worksheets("Users").Visible = xlSheetVisible
 
        Else
 
            .Protect Password:="YourPasswordHere"
 
            Worksheets("Users").Visible = xlSheetVeryHidden
 
        End If
    End With
End Sub

Place this code in a standard module:

Function AuthorizedUser(ByVal User As String, ByRef Admin As Boolean) As Boolean
    Dim ValidUser As Variant
    Dim ws As Worksheet
    Dim rng As Range
 
    On Error GoTo myerror
    With Sheets("Users")
        Set rng = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
    End With
 
    ValidUser = Application.Match(User, rng, False)
 
    If Not IsError(ValidUser) Then
        AuthorizedUser = True
        Admin = rng.Cells(ValidUser, 2).Value
    End If
 
myerror:
    If Err > 0 Then
        If Err.Number = 9 Then
            Set ws = Worksheets.Add
            With ws
                .Name = "Users"
                .Range("A1:B1").Value = Array("User", "Admin")
                .Range("A2").Value = Environ("Username")
                .Range("B2").Value = True
            End With
            Resume Next
        Else
            MsgBox (Error(Err)), 48, "Error"
        End If
    End If
End Function

Save & Close your workbook & then re-open. A new sheet should be created (Users) showing your network username & Admin set True.
Admin gives you access to the Users page.
Enter all your users network username in Column A & if you need others to update User Table set their Admin status True otherwise False.

Each time workbook is opened code will Unprotect Master sheet if user found on your list & unhide User Table if they are an Admin user otherwise sheet will be protected & user sheet hidden.

Amend Password where shown in RED.

Hope Helpful

Dave

 

[DaveA54]

Thank you so much. Works perfectly, very much appreciated.
Dave.

 

[DaveA54]

Mark - many thanks. Didn't work exactly as I wanted, but potentially useful for a different project.
Dave.

 

[dmt32]

Thank you so much. Works perfectly, very much appreciated.
Dave.

Hi,
suggestion does have it's weaknesses but should suffice for most users.

Thanks for feedback.

Dave