VBA Code Help!!

Maebus

New Member
Joined
Jun 25, 2024
Messages
20
Office Version
  1. 365
Platform
  1. Windows
I am creating a workbook to display employee performance stats with a separate sheet for each supervisor. I want it to work that each supervisor can only view their individual sheet and all others are very hidden so they cannot view other supervisors employees. I have code but when I have people test they are still able to view and select all worksheets. What am I missing or doing wrong? Here is what I have. Thanks in advance for any help.

Private Sub Workbook_Open()
Dim currentUser As String

' Get the current user
currentUser = Environ("USERNAME")

' Allow access to specific worksheets for specific users
Select Case currentUser
Case "JR", "A"
' Allow access to the worksheet named "A" for specific users
Sheets("A").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "B", "JR"
' Allow access to the worksheet named "B" for a specific user
Sheets("B").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "D", "JR"
' Allow access to the worksheet named "D" for a specific user
Sheets("D").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "I", "JR"
' Allow access to the worksheet named "I" for a specific user
Sheets("I").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "R", "JR"
' Allow access to the worksheet named "R" for a specific user
Sheets("R").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "S", "JR"
' Allow access to the worksheet named "S" for a specific user
Sheets("S").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("M").Visible = xlSheetVeryHidden
Case "M", "JR"
' Allow access to the worksheet named "M" for a specific user
Sheets("M").Visible = xlSheetVisible
' Hide specific worksheets very hidden for selected users
Sheets("A").Visible = xlSheetVeryHidden
Sheets("B").Visible = xlSheetVeryHidden
Sheets("C").Visible = xlSheetVeryHidden
Sheets("D").Visible = xlSheetVeryHidden
Sheets("I").Visible = xlSheetVeryHidden
Sheets("R").Visible = xlSheetVeryHidden
Sheets("S").Visible = xlSheetVeryHidden
End Select
End Sub
 
@Cubist so I have it working fine for me. However, I have one of the users testing functionality and they are receiving the same error message, but can only see their worksheet (need to also see the HomePage).
 
Upvote 0

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
Try this. Again change "JR" to super user name.
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
    Next ws
End Sub

Private Sub Workbook_Open()
    Dim currentUser As String
    Dim allowedSheet As String
    Dim ws As Worksheet

    ' Get the current user
    currentUser = Environ("USERNAME")
  
    If currentUser = "JR" Then 'Change "JR" to super user name
        For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
        Next ws
        Exit Sub
    Else
        allowedSheet = currentUser
    End If

    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = allowedSheet Then
            ws.Visible = xlSheetVisible
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next ws
    Worksheets("HomePage").Visible = xlSheetVisible
  
End Sub
 
Upvote 0
Try this. Again change "JR" to super user name.
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
    Next ws
End Sub

Private Sub Workbook_Open()
    Dim currentUser As String
    Dim allowedSheet As String
    Dim ws As Worksheet

    ' Get the current user
    currentUser = Environ("USERNAME")
 
    If currentUser = "JR" Then 'Change "JR" to super user name
        For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
        Next ws
        Exit Sub
    Else
        allowedSheet = currentUser
    End If

    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = allowedSheet Then
            ws.Visible = xlSheetVisible
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next ws
    Worksheets("HomePage").Visible = xlSheetVisible
 
End Sub
Perfect. It works. And I figured out the error issue. Thanks so much for your assistance.
 
Upvote 0
IMG_9932.jpeg
IMG_9933.jpeg
@Cubist im getting the following error for the line ws.Visible = xlSheetVeryHidden (screenshots)
 
Upvote 0
It's most likely because it's trying to hide every sheet because no one is found and you can't hide all the sheets, at least one must be visible. I see you removed the Home Page line. It was there as a default in case this happened.
 
Upvote 0
It's most likely because it's trying to hide every sheet because no one is found and you can't hide all the sheets, at least one must be visible. I see you removed the Home Page line. It was there as a default in case this happened.
Not sure what happened there. So I copied your last suggestion word for word and still same error for same line.
 
Upvote 0
I modified the code a bit. Try
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
    Next ws
End Sub
Private Sub Workbook_Open()
    Dim currentUser As String
    Dim allowedSheet As String
    Dim ws As Worksheet

    ' Get the current user
    currentUser = Environ("USERNAME")
 
    If currentUser = "JR" Then 'Change JR to super username
        Exit Sub
    Else
        allowedSheet = currentUser
    End If


 On Error GoTo NotFound

    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = allowedSheet Or ws.Name = "HomePage" Then
            ws.Visible = xlSheetVisible
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next ws
   
NotFound:
Worksheets("HomePage").Visible = xlSheetVisible

End Sub
 
Last edited:
Upvote 0
I modified the code a bit. Try
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    For Each ws In ThisWorkbook.Worksheets
            ws.Visible = xlSheetVisible
    Next ws
End Sub
Private Sub Workbook_Open()
    Dim currentUser As String
    Dim allowedSheet As String
    Dim ws As Worksheet

    ' Get the current user
    currentUser = Environ("USERNAME")
 
    If currentUser = "JR" Then 'Change JR to super username
        Exit Sub
    Else
        allowedSheet = currentUser
    End If


 On Error GoTo NotFound

    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = allowedSheet Or ws.Name = "HomePage" Then
            ws.Visible = xlSheetVisible
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next ws
  
NotFound:
Worksheets("HomePage").Visible = xlSheetVisible

End Sub
Ok that helped. Thank you. Now I need to add more users to have full visibility but when I try to add usernames after mine, it’s in red and doesn’t like it. How would you change the If currentUser statement to include multiple users?
 
Upvote 0
Ok that helped. Thank you. Now I need to add more users to have full visibility but when I try to add usernames after mine, it’s in red and doesn’t like it. How would you change the If currentUser statement to include multiple users?
Oh and actually it’s only allowing me to see the Home page. VBA is very confusing and frustrating but very necessary sometimes.
 
Upvote 0
Oh and actually it’s only allowing me to see the Home page. VBA is very confusing and frustrating but very necessary sometimes.
Did you close out the workbook first?

Change to Case for multiple users.
VBA Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    For Each ws In ThisWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next ws
End Sub

Private Sub Workbook_Open()
    Dim currentUser As String
    Dim allowedSheet As String
    Dim ws As Worksheet
    Dim sheetFound As Boolean

    ' Get the current user
    currentUser = Environ("USERNAME")
   
    Select Case currentUser
        Case "JR", "SuperUser1", "SuperUser2"  'Add more super usernames as needed
            Exit Sub
        Case Else
            allowedSheet = currentUser
    End Select

    sheetFound = False
   
    ' Loop through all sheets and set visibility
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = allowedSheet Or ws.Name = "HomePage" Then
            ws.Visible = xlSheetVisible
            sheetFound = True
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next ws

    ' If the allowedSheet is not found, show the HomePage sheet
    If Not sheetFound Then
        Worksheets("HomePage").Visible = xlSheetVisible
        MsgBox "User Not Found!" 'comment out if you don't want to show message box
    End If

End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,220,965
Messages
6,157,119
Members
451,398
Latest member
rjsteward

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top