Worksheet activate difficulty...

[nparsons75]

Hi all,

I found some code to enable me to protect certain worksheets from people unless signed in with rights to your sheet. Basically, admin can login which gives them access to all worksheets. A user can login and will be given access to the sheets they have permissions for.

When admin logs in and anyone else really, I would like the worksheet named menu be activated. Currently, when the file opens, it activates a particular sheet I see no reference to in the code. My sheet is named Environment...it is the 16th sheet to the right from the left whether that refers to anything or not im not sure... Hopefully someone can spot it, its above me... thanks in advance.


There are two sections of code.

This workbook

Option ExplicitDim shtCurrent As Worksheet
Const shtHome As String = "Home"
Const shtUsers As String = "Users"
Const shtEnableMacros As String = "EnableMacros"


Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    Dim wsUsers As Worksheet
    Dim Sh As Integer, c As Integer
    Dim ws As String
    
    If IsError(Worksheets("Users").Range("B1")) = True Or Worksheets("Users").Range("B1") < 2 Then
        Worksheets(shtHome).Visible = True
        Worksheets(shtEnableMacros).Visible = xlSheetHidden
        Exit Sub                'added 19-Jul-2016 m can be error value if invalid username has been entered
    End If
    Set wsUsers = Worksheets(shtUsers)
    If Worksheets("Users").Range("B1") < 2 Then Exit Sub
    If CBool(wsUsers.Cells(Worksheets("Users").Range("B1"), 3).Value) = True Then
        'admin user
        For Sh = 1 To Worksheets.Count
            Worksheets(Sh).Visible = xlSheetVisible
        Next Sh
    Else
        'show users sheet(s)
        c = 4
        On Error Resume Next
        Do
            ws = CStr(wsUsers.Cells(Worksheets("Users").Range("B1"), c).Text)
            If Len(ws) = 0 Then Exit Do
            Worksheets(ws).Visible = xlSheetVisible
            c = c + 1
        Loop
    End If
    Worksheets(shtHome).Visible = xlSheetHidden
    Worksheets(shtEnableMacros).Visible = xlSheetHidden
    shtCurrent.Activate
    
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim Sh As Integer
    
    Set shtCurrent = ActiveSheet
    
    Worksheets(shtEnableMacros).Visible = xlSheetVisible
    For Sh = 1 To Worksheets.Count
        If Worksheets(Sh).Name <> shtEnableMacros Then
            Worksheets(Sh).Visible = xlSheetVeryHidden
        End If
    Next Sh
End Sub


Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Workbook_BeforeClose False
End Sub


Private Sub Workbook_Open()
    Dim Sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, pw As String, ws As String
    Dim wsUsers As Worksheet
    
    'hide all but sheet named "Home"
    Worksheets(shtHome).Visible = xlSheetVisible
    Worksheets(shtHome).UserName.Text = ""
    Worksheets(shtHome).Password.Text = ""
    Worksheets("Users").Range("B1") = 0
    For Sh = 1 To Worksheets.Count
        If Worksheets(Sh).Name <> shtHome Then
            Worksheets(Sh).Visible = xlSheetVeryHidden
            Worksheets("menu").Activate
        End If
    Next Sh


End Sub

Module 1

Option ExplicitDim shtCurrent As Worksheet
Const shtHome As String = "Home"
Const shtUsers As String = "Users"
Const shtEnableMacros As String = "EnableMacros"


Sub Login()
    Dim Sh As Integer, c As Integer
    Dim rng As Range
    Dim UsersName As String, pw As String, ws As String
    Dim wsUsers As Worksheet
    
    Set wsUsers = Worksheets(shtUsers)
    Set rng = wsUsers.Range(wsUsers.Range("A1"), wsUsers.Range("A" & wsUsers.Rows.Count).End(xlUp))
    
    'Get Username and password and validate
        UsersName = Worksheets(shtHome).UserName.Text
        If UsersName = "" Then
            MsgBox "User Name is required!", vbCritical + vbOKOnly, "Usersname"
        End If
        Worksheets("Users").Range("B1") = Application.Match(UsersName, rng, False)
        If IsError(Worksheets("Users").Range("B1")) Then
            UsersName = ""
            MsgBox "Invalid Name!", vbCritical + vbOKOnly, "Usersname"
            Exit Sub
        End If
    
        pw = Worksheets(shtHome).Password.Text
        If pw = "" Then
            MsgBox "Password is required!", vbCritical + vbOKOnly, "User - " & UsersName
            Exit Sub
        End If
        If pw <> wsUsers.Cells(Worksheets("Users").Range("B1"), 2) Then
            pw = ""
            MsgBox "Incorrect password!", vbCritical + vbOKOnly, "User - " & UsersName
            Exit Sub
        End If
    
    Worksheets(shtHome).UserName.Text = ""
    Worksheets(shtHome).Password.Text = ""
    
    On Error GoTo myerror
    If Not IsError(Worksheets("Users").Range("B1")) Then
        If CBool(wsUsers.Cells(Worksheets("Users").Range("B1"), 3).Value) Then
            'admin user
            For Sh = 1 To Worksheets.Count
                Worksheets(Sh).Visible = xlSheetVisible
            Next Sh
        Else
            'show users sheet(s)
            c = 4
            On Error Resume Next
            Do
                ws = CStr(wsUsers.Cells(Worksheets("Users").Range("B1"), c).Text)
                If Len(ws) = 0 Then Exit Do
                Worksheets(ws).Visible = xlSheetVisible
                c = c + 1
            Loop
        End If
        Worksheets(shtHome).Visible = xlSheetHidden
        Worksheets(shtEnableMacros).Visible = xlSheetHidden
    Else
    
        MsgBox "You Do Not Have Authorised Access To This Workbook.", 16, "No Access"
        
    End If
Exit Sub


myerror:
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name <> "menu" Then
        If Sh.Name <> ActiveWorkbook.CustomDocumentProperties("auth").Value Then
            Sh.Visible = False
            MsgBox "You don't have authorization to view that sheet!"
        End If
    End If
End Sub
'Sub ShowAllSheets()
 '   Dim x As Integer
    
  '  For x = 1 To Worksheets.Count
   '     Worksheets(x).Visible = True
    'Next x
'End Sub