Hide Worksheets dependant on domain name

[Paul_Hossler]

These things a tendency to grow over time - new users, more worksheets, changed worksheets, removed users, etc.

I'd suggest a little 'data base' worksheet that can be more easily maintained

Capture.JPG


For 'Admin' you can replace that with your own UserID and when you open it you can see all the worksheets, including 'Users'

You can .Protect the Intro worksheet if you want, or make it really pretty and wow the boss

Option Explicit
Private Sub Workbook_Open()
    Application.ScreenUpdating = False
    
    Set wsUsers = Worksheets("Users")
    Set rUsers = wsUsers.Cells(1, 1).CurrentRegion
    Set wsIntro = Worksheets("Intro")
    
    sUserID = Environ("UserName")
    sUserName = Application.UserName
    wsIntro.Shapes("IntroBox").TextFrame2.TextRange.Text = "Hello" & vbLf & sUserName
    
    ShowRightWorksheets
    
    wsIntro.Select
    
    Application.ScreenUpdating = True
    
End Sub

Option Explicit
Option Private Module
Public wsUsers As Worksheet, wsIntro As Worksheet
Public sUserID As String, sUserName As String
Public rUsers As Range

Sub ShowRightWorksheets()
    Dim iUser As Long, iWS As Long
    Dim ws As Worksheet
    'if user not in list, use USER=Unknown in col B
    iUser = 2
    On Error Resume Next
    iUser = Application.WorksheetFunction.Match(sUserID, rUsers.Rows(1), 0)
    On Error GoTo 0
    'find the WS row
    For Each ws In ActiveWorkbook.Worksheets
        iWS = 0
        On Error Resume Next
        iWS = Application.WorksheetFunction.Match(ws.Name, rUsers.Columns(1), 0)
        On Error GoTo 0
        
        'if the WS is in the list
        If iWS > 0 Then
            'if the row/col is empty then VeryHide the WS
            If Len(rUsers.Cells(iWS, iUser).Value) = 0 Then
                ws.Visible = xlSheetVeryHidden
            'otherwise show the WS
            Else
                ws.Visible = xlSheetVisible
            End If
        
        'if WS NOT in list, then VeryHide it
        Else
            ws.Visible = xlSheetVeryHidden
        End If
    Next
End Sub
'super secret hidden macro that you need to know the name of
'so that you can type it in with Alt-F8 - Run Macro
Sub SuperSecret()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        ws.Visible = xlSheetVisible
    Next
End Sub