username access to different worksheet VBA

[cilantro00]

hi i would need help with a VBA code that have very specific properties.
im working on a workbook where each user should only have access to view and edit the sheet assigned to their username. Only when the username is "ADMIN" that all sheets are unhidden. i tried to set up an inputbox for users to enter their username, which would then unhide the corresponding sheet. However, the set up doesn't seem to work when there a more than one user accessing the workbook simultaneously. The codes exposes all unhidden sheets to all users instead of unhidding one sheet per user. i tried to set it up so that the sheet closes itself after 5 minutes but it does not seem to work properly with multiple users on it.

Option Explicit


 


Dim username As String
Dim foundSheet As Boolean
Dim ws As Worksheet
Dim activeSheetName As String


 


Sub HideSheets()
   Dim ws As Worksheet
   activeSheetName = ActiveSheet.Name ' Store the name of the currently active sheet
   
   For Each ws In ThisWorkbook.Sheets
       If ws.Visible = xlSheetVisible And ws.Name <> activeSheetName Then
           ws.Visible = xlSheetVeryHidden
       End If
   Next ws
End Sub


 


Sub ShowSheets()
   Dim ws As Worksheet
   For Each ws In ThisWorkbook.Sheets
       ws.Visible = xlSheetVisible
   Next ws
End Sub


 


Sub User()
   Dim ws As Worksheet


 


    foundSheet = False
   
   Do
       username = InputBox("Please enter username:", "Username")
       If username = "" Then
           MsgBox "No username entered. Exiting.", vbExclamation
           Exit Sub
       End If
       username = UCase(username)


 


        If username = "ADMIN" Then
           Call ShowSheets
           Exit Sub
       End If


 


        For Each ws In ThisWorkbook.Worksheets
           If UCase(ws.Name) = username Then
               ws.Visible = xlSheetVisible
               foundSheet = True
               Exit For
           End If
       Next ws


 


        If Not foundSheet Then
           MsgBox "No sheet found with the name: " & username, vbExclamation
       End If
   Loop Until foundSheet = True


 


    If foundSheet Then
       Application.OnTime Now + TimeValue("00:00:05"), "HideSheets"
   End If
End Sub


 


Sub Appeler1()
   Call HideSheets
   Call User
End Sub

 

[jkpieterse]

If I happen to know someone else's username I can view his/her tab? Doesn't sound very secure.

 

[jkpieterse]

Environ("Username")

should give you the username as the user is logged on with.

 

[jkpieterse]

You could add this code to the ThisWorkbook module:

Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim un As String
    un = Environ("username")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = un Then
            sh.Activate
            Exit For
        End If
    Next
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Workbook_Open
End Sub

 

[cilantro00]

You could add this code to the ThisWorkbook module:

Private Sub Workbook_Open()
    Dim sh As Worksheet
    Dim un As String
    un = Environ("username")
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name = un Then
            sh.Activate
            Exit For
        End If
    Next
End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    Workbook_Open
End Sub

i’m still new to VBA and coding in general so i’m a bit lost about how Environ works or how it’s set up in general. I tried putting it in ThisWorkbook but when i open the workbook, it shows me other sheets that are assigned to other usernames.