May 16 2024 09:49 AM
Greetings,
I found the code below and it gets me moving in the right direction but I would like to have significantly more autonomy over the users and which worksheets they can access within a spreadsheet. Here is the code:
Private Sub Workbook_Open()
Dim pword As String
On Error GoTo endit
pword = InputBox("Enter logon information to access permitted worksheets")
Select Case pword
Case Is = "TEST": Sheets("NOT MANAGER").Visible = True
Case Is = "MANAGER": Call UnHideAllSheets
End Select
Sheets("Dummy").Visible = False
Exit Sub
endit:
MsgBox "Incorrect Password"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sht As Worksheet
Application.ScreenUpdating = False
Sheets("Dummy").Visible = xlSheetVisible
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> "Dummy" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
Application.ScreenUpdating = True
End Sub
Sub UnHideAllSheets()
Application.ScreenUpdating = False
Dim n As Single
For n = 1 To Sheets.Count
Sheets(n).Visible = True
Next n
Application.ScreenUpdating = True
End Sub
I like the idea of a dummy worksheet that the spreadsheet uses but I would like to incorporate a username in conjunction with a password to give access to users based on what they need access to. Additionally, rather than having to change usernames and passwords in VBA, I would like to have a hidden worksheet that an administrator can go in to add/delete/modify usernames, passwords and the worksheets each user has access to.
Not sure if this is possible but if so it is definitely beyond me and I would appreciate any assistance.
Thanks,
C
May 17 2024 06:09 AM
To achieve the level of control and flexibility you're looking for, we can expand upon the existing VBA code. Here's a comprehensive solution that involves:
Let's break this down step-by-step.
Step 1: Setting Up the Hidden Worksheet
Create a hidden worksheet (let's name it "UserAccess") with the following structure:
Username | Password | Sheet1 | Sheet2 | ... |
user1 | pass1 | TRUE | FALSE | ... |
user2 | pass2 | FALSE | TRUE | ... |
Each column after the "Password" column corresponds to a worksheet name. Use TRUE or FALSE to indicate whether the user has access to that sheet.
Step 2: VBA Code to Handle User Login and Sheet Access
Here's the updated VBA code to handle login and sheet access based on the "UserAccess" worksheet:
Vba Code is untested, please backup your file.
Private Sub Workbook_Open()
Dim username As String
Dim pword As String
Dim ws As Worksheet
Dim wsAccess As Worksheet
Dim lastRow As Long
Dim userFound As Boolean
Dim sheetCol As Integer
Dim cell As Range
On Error GoTo endit
' Get login information
username = InputBox("Enter your username")
pword = InputBox("Enter your password")
' Set the UserAccess worksheet
Set wsAccess = ThisWorkbook.Sheets("UserAccess")
wsAccess.Visible = xlSheetVisible ' Temporarily make it visible
' Find the last row in the UserAccess worksheet
lastRow = wsAccess.Cells(wsAccess.Rows.Count, 1).End(xlUp).Row
userFound = False
For Each cell In wsAccess.Range("A2:A" & lastRow) ' Assuming headers are in row 1
If cell.Value = username And cell.Offset(0, 1).Value = pword Then
userFound = True
' Loop through sheets and set visibility based on UserAccess
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "UserAccess" And ws.Name <> "Dummy" Then
sheetCol = Application.WorksheetFunction.Match(ws.Name, wsAccess.Rows(1), 0)
If cell.Offset(0, sheetCol - 1).Value = True Then
ws.Visible = xlSheetVisible
Else
ws.Visible = xlSheetVeryHidden
End If
End If
Next ws
Exit For
End If
Next cell
wsAccess.Visible = xlSheetVeryHidden ' Hide the UserAccess sheet again
If Not userFound Then
MsgBox "Incorrect Username or Password"
End
End If
Sheets("Dummy").Visible = False
Exit Sub
endit:
MsgBox "Error occurred during login process"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sht As Worksheet
Application.ScreenUpdating = False
Sheets("Dummy").Visible = xlSheetVisible
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> "Dummy" And sht.Name <> "UserAccess" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
Application.ScreenUpdating = True
End Sub
Step 3: Testing the Setup
Additional Notes:
This setup should provide the flexibility to manage users and their access to different worksheets without modifying the VBA code every time a change is needed. The text, step and code was created with the help of AI.
My answers are voluntary and without guarantee!
Hope this will help you.
Was the answer useful? Mark as best response and like it!
This will help all forum participants.
May 17 2024 10:06 AM
May 17 2024 11:02 AM
Let's address the issues you mentioned:
Here's the revised VBA code:
Vba Code is untested, please backup your file.
Private Sub Workbook_Open()
Dim username As String
Dim pword As String
Dim ws As Worksheet
Dim wsAccess As Worksheet
Dim lastRow As Long
Dim userFound As Boolean
Dim sheetCol As Integer
Dim cell As Range
On Error GoTo endit
' Get login information
username = InputBox("Enter your username")
pword = InputBox("Enter your password")
' Set the UserAccess worksheet
Set wsAccess = ThisWorkbook.Sheets("UserAccess")
wsAccess.Visible = xlSheetVisible ' Temporarily make it visible
' Find the last row in the UserAccess worksheet
lastRow = wsAccess.Cells(wsAccess.Rows.Count, 1).End(xlUp).Row
userFound = False
For Each cell In wsAccess.Range("A2:A" & lastRow) ' Assuming headers are in row 1
If cell.Value = username And cell.Offset(0, 1).Value = pword Then
userFound = True
' Loop through sheets and set visibility based on UserAccess
For Each ws In ThisWorkbook.Sheets
If ws.Name <> "UserAccess" And ws.Name <> "Dummy" Then
sheetCol = Application.WorksheetFunction.Match(ws.Name, wsAccess.Rows(1), 0)
If cell.Offset(0, sheetCol - 1).Value = True Then
ws.Visible = xlSheetVisible
Else
ws.Visible = xlSheetVeryHidden
End If
End If
Next ws
Exit For
End If
Next cell
If userFound Then
wsAccess.Visible = xlSheetVeryHidden ' Hide the UserAccess sheet again
Sheets("Dummy").Visible = xlSheetVeryHidden ' Hide the Dummy sheet
Else
MsgBox "Incorrect Username or Password"
End
End If
Exit Sub
endit:
MsgBox "Error occurred during login process"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim sht As Worksheet
Application.ScreenUpdating = False
Sheets("Dummy").Visible = xlSheetVisible
Sheets("UserAccess").Visible = xlSheetVisible ' Ensure UserAccess is visible for admin purposes
For Each sht In ActiveWorkbook.Sheets
If sht.Name <> "Dummy" And sht.Name <> "UserAccess" Then
sht.Visible = xlSheetVeryHidden
End If
Next sht
Application.ScreenUpdating = True
End Sub
Explanation of Changes:
Testing the Changes:
These changes should resolve the issues you encountered and provide the desired functionality for hiding/unhiding worksheets based on username and password. You can also develop the rest yourself (if more is needed) .
May 17 2024 11:31 AM