How to restrict access to worksheets per user

[Legacy 374719]

Hi guys, I was wondering whether you could help, I have a workbook with 10 different sheets, that I share with 9 other people, First sheet is what everyone can see, then each has their own work sheet they work with. I need to find a way to restrict access and visibility of other sheets. so that user 1 can see sheet 2 only, user 2 can see sheet 3 only and so on. And lastly I'd like a super user, myself, who can see all sheets. Can anyone advice how to achieve this with VBA?

 

[gallen]

Check the 'sSName' variable is holding the correct string value. When the debug highlights it, hover your mouse over the variable to see what its value is. Ensure it's exactly the same name as the sheet

 

[Legacy 374719]

hmmm, not quite following what you mean, sorry, when I hover over it nothing happens...


this is my userform1

Private Sub UserForm_Click()
Dim bOK2Use As Boolean

Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean

    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "user1"
                sSName = "Sheet2"
                If txtPass.Text <> "u1pass" Then bError = True
            Case "user2"
                sSName = "Sheet3"
                If txtPass.Text <> "u2pass" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If

        Sheets(sSName).Visible = xlSheetVisible
        Sheets(sSName).Unprotect (txtPass.Text)
        Sheets(sSName).Activate

        bOK2Use = True
        Unload UserForm1
    End If
End Sub

Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If
End Sub

This is my ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim w As Worksheet
    Dim bSaveIt As Boolean

    bSaveIt = False
    For Each w In Worksheets
        If w.Visible Then
            Select Case w.Name
                Case "Sheet2"
                    w.Protect ("u1pass")
                    w.Visible = False
                    bSaveIt = True
                Case "Sheet3"
                    w.Protect ("u2pass")
                    w.Visible = False
                    bSaveIt = True
            End Select
        End If
    Next w
    If bSaveIt Then
        ActiveWorkbook.CustomDocumentProperties("auth").Delete
        ActiveWorkbook.Save
    End If
End Sub

Private Sub Workbook_Open()
    UserForm1.Show
End Sub

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "Main" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
    End If
End Sub

 

[gallen]

I see exactly what that code is doing but we need to just back up to your first point:

the above guide gives me following problem: I get error - 'Run-time error '1004': Unable to set the Visible property of the Worksheet class.
Debug highlights this part: Sheets(sSName).Visible = True

You seem to be struggling with what sSName actually is which is problematic.

It's a string value and it is Defined here:

[COLOR=#574123]Dim sSName As String[/COLOR]

It is then assigned here:

Select Case txtUser.Text    Case "user1"
        sSName = "Sheet2"
        If txtPass.Text <> "u1pass" Then bError = True
    Case "user2"
        sSName = "Sheet3"
        If txtPass.Text <> "u2pass" Then bError = True
    Case Else
        bError = True
End Select

the above code, in plain English says "If the text in txtUser = 'user1' then sSName = 'Sheet2'. The password to edit this sheet is 'u1pass'


The 'Unable to set the Visible property of the Worksheet class. ' is a simple error. As far as I'm aware, theres only 2 things that could be generating this:

1. The Variable - sSname isn't holding the correct string (eg "Sheet1" isn't a valid name for a sheet in your workbook)
2. Your worksheet is protected and so any manipulation of the properties will result in an error

So let's deal with this error first then we can move on. Check sSName is a valid name and check the worksheet isn't protected

 

[gallen]

Point of note regarding user name - you can get the windows log-on name simply by replacing

Application.UserName

with

Environ("UserName")

 

[Legacy 374719]

Can't use windows logon either unfortunately ,

right I created the above file from scratch again and this time, instead of hiding the sheets first I left them visible and I didn't protect the work sheet. authentication seemed to be working, so it seems me hiding the sheets manually what threw it off the track. However now once I tried to close the file it threw same error, but it pointed to ThisWorkbook and different part:
Run-time error '1004': Unable to set the Visible property of the Worksheet class.
debug highlighted: Sh.Visible = False

Is there a way to attach files, so I could show you the file I am working with?

 

[gallen]

Is there a way to attach files, so I could show you the file I am working with?

You can but I can't download as I'm at work I've PMd you an alternative.

May be an issue with protection. Send it and I'll see.

Edit:

Are you trying to hide ALL sheets? 1 sheet must be visible at any one time. If you are trying to hide the only visible sheet you will get an error

 

[gallen]

My apologies, I can't get any email with attachments through to my work pc. Did you see my edit in the previous post?

 

[gallen]

Just re-read your code. I didn't spot you were protecting the workbook.

You will need to unprotect your workbook, perform your code then Protect the workbook again.

so your code should be something like:

[COLOR=#333333]Private Sub UserForm_Click()[/COLOR]Dim bOK2Use As Boolean

Private Sub btnOK_Click()
    Dim bError As Boolean
    Dim sSName As String
    Dim p As DocumentProperty
    Dim bSetIt As Boolean
    
    [COLOR=#ff0000][B]ThisWorkbook.Unprotect[/B][/COLOR]
    bOK2Use = False
    bError = True
    If Len(txtUser.Text) > 0 And Len(txtPass.Text) > 0 Then
        bError = False
        Select Case txtUser.Text
            Case "user1"
                sSName = "Sheet2"
                If txtPass.Text <> "u1pass" Then bError = True
            Case "user2"
                sSName = "Sheet3"
                If txtPass.Text <> "u2pass" Then bError = True
            Case Else
                bError = True
        End Select
    End If
    If bError Then
        MsgBox "Invalid User Name or Password"
    Else
        'Set document property
        bSetIt = False
        For Each p In ActiveWorkbook.CustomDocumentProperties
            If p.Name = "auth" Then
                p.Value = sSName
                bSetIt = True
                Exit For
            End If
        Next p
        If Not bSetIt Then
            ActiveWorkbook.CustomDocumentProperties.Add _
              Name:="auth", LinkToContent:=False, _
              Type:=msoPropertyTypeString, Value:=sSName
        End If

        Sheets(sSName).Visible = xlSheetVisible
        Sheets(sSName).Unprotect (txtPass.Text)
        Sheets(sSName).Activate

        bOK2Use = True
        Unload UserForm1
    End If
    [COLOR=#ff0000][B]ThisWorkbook.Protect[/B][/COLOR]
End Sub

Private Sub UserForm_Terminate()
    If Not bOK2Use Then
        ActiveWorkbook.Close (False)
    End If [COLOR=#333333]End Sub[/COLOR]

Protection of worksheets/workbooks can be troublesome when using macros. Always unprotect, run your code then protect again

 

[Tahas]

To achieve exactly what you asked you could put this code in the 'ThisWorkbook' module of the Code section:

Private Sub Workbook_Open()
    ShowSheet
End Sub


Sub ShowSheet()
    Dim ws As Worksheet
    Dim wsAllowed As Worksheet
   
    'If SuperUser, show all:
    If Application.UserName = "SuperUserName" Then 'insert Super User's name here
        For Each ws In Worksheets
           ws.Visible = xlSheetVisible
        Next
        Exit Sub
    End If
   
    'If not a super user, only show the associated sheet
    Set wsAllowed = GetAllowedSheet
    wsAllowed.Visible = xlSheetVisible 'make sure the sheet is visible before hiding the others
   
    'Hide all sheets that user isn't permitted to see.
    For Each ws In Worksheets
        If ws.Name <> wsAllowed.Name Then ws.Visible = xlSheetHidden
    Next
   
End Sub


Function GetAllowedSheet() As Worksheet
    'Set the sheet each user is allowed to use here.
   
    'adapt the case statements for correct users and correct sheets to display
    Select Case Application.UserName
        Case "User 1"
           Set GetAllowedSheet = Sheets("Sheet2")
        Case "User 2"
           Set GetAllowedSheet = Sheets("Sheet1")
        Case Else
            'If code gets here then User Name is unhandled.
    End Select
End Function

Naturally it would need modifying to have the correct usernames and to handle what would happen if the username is unknown.


Having said that I'd keep all sheets visible but in the 'WorkSheet_Change' event of each sheet I'd check the username and if they aren't allowed to make any, pop up a message box and undo the change.

Hi Gallen,
Thanks for being an inspiration to me. My challenge is that the code works in Excel desktop but doesn't work in Microsoft Teams, SharePoint and in Browser. Would you advise how can we restrict users from all Excel application types?

Thanks for your response in advance.
Taha

 

[gallen]

Hi Gallen,
Thanks for being an inspiration to me. My challenge is that the code works in Excel desktop but doesn't work in Microsoft Teams, SharePoint and in Browser. Would you advise how can we restrict users from all Excel application types?

Thanks for your response in advance.
Taha

Apologies but that is beyond my skill set.