CODEWITHSUNDEEP
excelvba
Hoesl
Hoesl

Reputation: 23

Restricting viewing and editing access to a single worksheet

I have an Excel document that is accessed by many people.

The data is not private but people get confused because different people need to view different sheets in the workbook.

I want that every sheet has a different password, so when you type in that password, it redirects you to a specific worksheet.

I would give out the different passwords to the corresponding persons or something like that.

I can't save these sheets as single documents because they use each other for calculations.

Private Sub Workbook_Open()
Pwevaluation
End Sub


Public Function Pwevaluation()
Dim sh As Worksheet
Dim pw As String

pw = InputBox("Please enter your name", "Access Required", "")
Select Case pw
    Case Is = "hoesl"
        For Each sh In Worksheets
            If sh.Name = "Hinweis" Then
                sh.Visible = xlSheetVisible
            Else
            If sh.Name = "Blatt 1" Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If

            End If
        Next sh
    Case Is = ""
    Case Else
        For Each sh In Worksheets
            If sh.Name = "Deckblatt" Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If
        Next sh
        pw = InputBox("Wrong name, please try again", "Access Required", "")
        Pwevaluation
End Select
End Function

When the sheets I'm trying to call are already hidden, I get

runtime error "1004"

If they are not hidden, everything works.

Upvotes: 0

Views: 619

Answers (1)

Plutian
Plutian

Reputation: 2309

Since I felt like experimenting, this should help you well underway:

Private Sub Workbook_Open()
Dim sh As Worksheet
Sheets(Sheets.Count).Visible = xlSheetVisible
Select Case Environ("Username")
    Case Is = "Plutian"
        For Each sh In Worksheets
            If sh.Name = "Naughty Stuff" Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If
        Next sh
    Case Else
        MsgBox "Insufficient access, see Hoesl for more info"
End Select
End Sub

Please note the line Sheets(Sheets.Count).Visible = xlSheetVisible is important in this case. If the sheet being unhidden is after the currently visible sheet, it might occur that this sub attempts to hide the last visible sheet (to unhide another sheet later on). This isn't possible and throws an error, therefore this line will unhide the last sheet in any case, so it'll always be active and be hidden last after all other actions are done. This prevents all sheets being hidden at one time.

EDIT I suggested another method below, by adding a list of users and access restrictions in a hidden sheet. Since I was interested to get that working, I explored that method as well:

Private Sub workbk_Open()
Dim user As Integer, sh As Worksheet

Sheets(Sheets.Count).Visible = xlSheetVisible 'unhide last sheet to prevent all sheets being hidden at once

user = Application.IfError(Application.Match(Environ("username"), ThisWorkbook.Sheets("Sheet3").Range("A2:A5"), 0), "0") 'check if user is present in access list

If user > 0 Then
    For Each sh In Worksheets 'loop through sheets
        If Application.IfError(Application.Match(sh.Name, ThisWorkbook.Sheets("Sheet3").Range(Cells(user + 1, 2), Cells(user + 1, 4)), 0), "0") > 0 Then 'check if sheet is in access list for user
            sh.Visible = xlSheetVisible 'if true, set sheet to visible
            Else
            sh.Visible = xlSheetHidden 'if false, hide sheet
        End If
    Next sh
    Else
    Workbook.Protect 'If user not found, protect workbook to prevent altering
    MsgBox "user not found, see admin for access" 'display error message
End If
End Sub

The access list would look like so, where the values represent sheet names. In my code this would be located in sheet3, and only runs from row 2 to 5 for users and column B to D for sheets, but this can be expanded nearly infinitely.

A             B             C
Username:     Access:
Plutian       Data sheet    Maintenance sheet
Hoesl         Sheet2        Maintenance sheet
Randomguy     Randomsheet   Sheet3
etc...

I hope the comments explain sufficiently, if not, let me know.

EDIT EDIT To update either of these answers with a prompt box with either a password (or by just having the users input their name or a unique key) you can use an input box like so:

Dim pw as string
pw = InputBox("Please enter your name", "Access Required", "")

And have the code search for the password/input box input in either case:

Select Case pw

or

user = Application.IfError(Application.Match(pw, ThisWorkbook.Sheets("Sheet3").Range("A2:A5"), 0), "0")

Just make sure you keep the sheet where you store your passwords hidden at all time when going the second route. And think about how you want to handle wrong passwords.

Upvotes: 1

Related Questions