VBA Excel Username grants access - excel

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...

Answer 1

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

Answer 2

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