VBA Excel Username grants access

Question

Looking for a little help, I have an excel document that should only grant certain users access, all employees have a user name and when they input any information that shows up with their entry. I'm hoping to secure the file so that only certain employees can have access. So far I have

Private Sub Workbook_Open()
 Dim Users As Variant
 Dim UName As String
 Dim UFind As Variant
 Users = Array("JBLOGS", "DOEJOHN", "ASmith", "JanDoe")

 UName = Environ("UserName")
 On Error Resume Next
 UFind = WorksheetFunction.Match(UName, Users, 0)
 If Err <> 0 Then
     MsgBox "You are not authorised to use this Workbook"
     ThisWorkbook.Close SaveChanges:=False
 End If
 End Sub

This is fine, but I had wanted it to be on a sheet of its own ie column titled Users then a list of users that can be added to easily.

I also was wondering if certain users could be restricted to certain sheets, for example, John Doe is in Africa, Jane is in America, can I restrict them to only see sheets titled 'Africa' and 'America'

Had a look and couldn't see anything, so not sure if it easily done...

You'll need to consider what happens if a user opens the workbook with events disabled, or with Macros disabled. Your code won't run, and the workbook will stay open. As PeterT suggests, your best option (which is by no means secure), is to *only* unhide the sensitive worksheets if the user is valid. That requires VBA to be running, and the events to fire, and the usernames to pass the test. — ThunderFrame, May 05 '16 at 14:45
It is going to be secured by passwords and 'read only' I have code to make sure the users cant save it etc, I would keep it 'Very Hidden' in Visual Basic and the intended users are in the same company, so it doesn't need to be hugely secure - or else I wouldn't be using Excel. Thanks though @ThunderFrame do you have any idea about the code that it would entail having a veryhiddensheet with a list of valid users? — user5836742, May 05 '16 at 14:48

PeterT · Answer 1 · 2016-05-09T16:11:10.363

I'd suggest creating a hidden worksheet to hold your list of usernames, you can even protect the hidden sheet with a password if desired. Additionally, you could expand your username list to a table that lists the worksheets each user is allowed to view. Any sheets disallowed by the table could also be hidden from that user (and, of course, unhidden for a different user with granted access). As a side note, you may find it useful to make a case-insensitive comparison of usernames from the table to the environment variable - this has tripped me up sometimes.

EDIT1: Here's an example to get you started:

Create a worksheet named "AuthUsers" and then create a table named "UserTable". Define two columns in the table, the first called "Users" and the second called "Sheets".

EDIT2: Added the ViewAuthorizedSheets method to hide/view appropriate worksheets and updated the test sub. This also works just fine when called from Worksheet_Open.

Option Explicit

Sub test()
    Debug.Print "user is authorized = " & IsUserAuthorized(Environ("UserName"))
    ViewAuthorizedSheets Environ("UserName")
    If IsUserAuthorized(Environ("UserName")) Then
        Debug.Print "authorized sheets = " & GetAuthorizedSheets(Environ("UserName"))
    Else
        MsgBox "User is not authorized to view any sheets.", vbCritical + vbOKOnly
    End If
End Sub

Public Sub ViewAuthorizedSheets(uname As String)
    Dim authSheets As String
    Dim sh As Worksheet
    uname = Environ("UserName")
    authSheets = GetAuthorizedSheets(uname)
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "AuthUsers" Then
            If InStr(1, authSheets, sh.Name, vbTextCompare) > 0 Then
                sh.Visible = xlSheetVisible
            Else
                sh.Visible = xlSheetHidden
            End If
        End If
    Next sh
End Sub

Function IsUserAuthorized(uname As String) As Boolean
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As Boolean

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.ListColumns("Users").DataBodyRange
    allowed = False
    For Each allowedUser In userList
        If LCase(allowedUser) = LCase(uname) Then
            allowed = True
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    IsUserAuthorized = allowed
End Function

Function GetAuthorizedSheets(uname As String) As String
    Dim ws As Worksheet
    Dim userTbl As ListObject
    Dim userList As Range
    Dim allowedUser As Variant
    Dim allowed As String

    Set ws = ThisWorkbook.Sheets("AuthUsers")
    Set userTbl = ws.ListObjects("UserTable")
    Set userList = userTbl.DataBodyRange
    allowed = False
    For Each allowedUser In userList.Columns(1).Cells
        If LCase(allowedUser) = LCase(uname) Then
            allowed = allowedUser.Offset(0, 1).value
            Exit For
        End If
    Next allowedUser
    Set userList = Nothing
    Set userTbl = Nothing
    Set ws = Nothing
    GetAuthorizedSheets = allowed
End Function

In your ThisWorkbook module, the call is accessed simply by

Option Explicit

Private Sub Workbook_Open()
    ViewAuthorizedSheets Environ("UserName")
End Sub

Hi I have seen some VBA that uses this idea of a 'Users' sheet, but when I added it and added my own Username it locked me out - proving that part of it worked ie the [[[[[ThisWorkbook.Close SaveChanges:=False]]]]] but it was like it wasn't reading from the sheet and just assuming my username was wrong? — user5836742, May 05 '16 at 14:44
Must be doing something wrong as it isn't working - it's not coming up as failing, just ignoring the macro completely. — user5836742, May 06 '16 at 12:00
Is your macro in the `ThisWorkbook` module? Put some `Debug.Print` statements in the macro to make sure it's firing. Also check that macros are allowed. — PeterT, May 06 '16 at 12:09
Yes Macros are allowed, all my other macros are running as normal. Yes, in ThisWorkbook. Have you used this particular macro before? — user5836742, May 06 '16 at 12:33
I have not used the macro in my posted no, that was an example tailored for your situation. I have used logic in `Workbook_Open` many times with great success, including permissions-based logic similar to yours. Try starting with a brand new, completely empty workbook and define your worksheet names and set up the AuthUsers sheet and see how it goes. Sometimes getting a simple example running as a functional workbook is the first step in figuring out what is affecting your application. — PeterT, May 06 '16 at 14:37
No, it doesn't work - tried everything in a new work book etc. Thanks anyway PeterT — user5836742, May 09 '16 at 15:09
@PeterT May I ask whats the purpose of the test sub? It seems to me that the macro does not use it at all. — byte me, Feb 14 '20 at 11:14
The test is just an example on how to use the function `IsUserAuthorized` and the sub `ViewAuthorizedSheets`, which changes the visibility settings of the worksheets, based on the permissions defined in the `UserTable`. — PeterT, Feb 14 '20 at 17:02

score 0 · Answer 2 · answered May 05 '16 at 14:56

Private Sub Workbook_Open()

    Dim EmpArray(3) As String
    Dim Count As Integer

    EmpArray(0) = "dzcoats"
    EmpArray(1) = "cspatric"
    EmpArray(2) = "eabernal"
    EmpArray(3) = "lcdotson"

    Count = 0

    For i = LBound(EmpArray) To UBound(EmpArray)
    If Application.UserName = EmpArray(i) Then Count = Count = 1
    Next i

    If Count = 0 Then
        MsgBox ("You dont have access to this file")
        ThisWorkbook.Close SaveChanges:=False
    End If

End Sub

This should work. My Count logic is sloppy though but it does the trick

Thanks for the help - this works the same way my initial macro worked. I was looking to have a macro that reads from a users sheet a list of user names and a list of sheets each user can access next to it (if they aren't on the user sheet to shut down the document) — user5836742, May 09 '16 at 15:11

VBA Excel Username grants access

2 Answers2

Linked