Unprotecting a worksheet by user ID

DaveA54

New Member
Joined
Mar 17, 2015
Messages
3
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.
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,678
Office Version
  1. 365
Platform
  1. Windows
  2. Mobile
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...

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

Code:
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

Well-known Member
Joined
Jul 3, 2012
Messages
7,796
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
Hi welcome to the board.
See if this solution helps you.

Place this code in the Thisworkbook Code page:

Rich (BB code):
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:

Rich (BB code):
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

New Member
Joined
Mar 17, 2015
Messages
3
Thank you so much. Works perfectly, very much appreciated.
Dave.
 
Last edited:

DaveA54

New Member
Joined
Mar 17, 2015
Messages
3
Mark - many thanks. Didn't work exactly as I wanted, but potentially useful for a different project.
Dave.
 

dmt32

Well-known Member
Joined
Jul 3, 2012
Messages
7,796
Office Version
  1. 2021
  2. 2019
Platform
  1. Windows
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
 

Forum statistics

Threads
1,181,322
Messages
5,929,289
Members
436,660
Latest member
Mouseinalabyrinth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top