Protection‎ > ‎

Pwd Hidden Sheets

PROBLEM:
"From a front sheet that is the only visible sheet in a workbook, I'd like users to enter a password
and their sheet is unhidden automatically for them.  There are many sheets so there needs to be
a way to list passwords and the sheets they unhide
.  Also, if the users could change their own password,
that would be best of all."


SPECIFICATIONS - ONE SHEET PER PASSWORD:

NOTE:
Normally the VBA for a project like this is password protected, too. In the sample workbook above it is not protected. Be sure to password protect your code after you apply it to your own projects.  If users can see the VBA and guess the name of your hidden "passwords" sheet, then there's no point to this.  Name your actual passwords page something unlikely, like PWDHAMSTER199.
  1. A hidden sheet lists passwords in column A, sheetnames in column B
  2. A user prompt asks for a password, if it matches a sheet that sheet is unhidden and activated
  3. Leaving a user's sheet will cause that sheet to hide again
  4. User's can change their passwords
This code goes in the ThisWorkbook module, it handles the autohiding of all sheets when you leave those sheets.

CODE

Option Explicit

Private Sub Workbook_SheetDeactivate(ByVal ws As Object)
    If ws.Name <> "Sheet1" Then ws.Visible = xlVeryHidden
End Sub



This code goes into a standard code module and is attached to a button to prompt for a password:

CODE

Option Explicit

Sub PasswordChecker()
'Author:    Jerry Beaucaire, 7/21/2010
'Summary:   uses passwords in a hidden table to unhide sheets based on pwds
Dim Pwd As String, PwdPos As Long
Dim MySheet As String

    Pwd = Application.InputBox _
        ("Please enter a password for your sheet", "Password", Type:=2)
    If Pwd = "False" Then Exit Sub
    On Error Resume Next
    PwdPos = WorksheetFunction.Match _
            (Pwd, Sheets("Passwords").Range("A:A"), 0)
   
    If PwdPos > 0 Then
        MySheet = WorksheetFunction.VLookup _
            (Pwd, Sheets("Passwords").Range("A:B"), 2, 0)
    Else
        MsgBox "No sheets are unlocked with that password."
        Exit Sub
    End If
   
    With Sheets(MySheet)
        .Visible = True
        .Activate
    End With

End Sub




This code also goes into a standard code module, this handles the changing of passwords by users:

CODE

Sub ChangeMyPassword()
'Author:    Jerry Beaucaire, 9/12/2010
'Summary:   lets a user change their password stored on the hidden sheet
Dim PwdOld As String
Dim PwdNew As String, PwdNw2 As String
Dim PwdChk As Long, PwdPos As Long

StartAgain:
PwdOld = Application.InputBox _
    ("Please enter OLD password", "Password", Type:=2)
If PwdOld = "False" Then Exit Sub
On Error Resume Next
PwdPos = WorksheetFunction.Match _
    (PwdOld, Sheets("Passwords").Range("A:A"), 0)

    If PwdPos > 0 Then
RedoNewPassword:
        PwdNew = Application.InputBox _
            ("Please enter NEW password", "Password", Type:=2)
        If PwdNew = "False" Then
            MsgBox "Password not changed"
            Exit Sub
        End If
        If Application.InputBox("Please reenter the NEW password", _
                                "Password", Type:=2) <> PwdNew Then
            MsgBox "Passwords do not match, try again"
            GoTo RedoNewPassword
        End If
        PwdChk = WorksheetFunction.Match _
            (PwdNew, Sheets("Passwords").Range("A:A"), 0)
        If PwdChk > 0 Then
            If MsgBox("Not allowed, would you like to try another new password?", _
                vbYesNo + vbQuestion, "Retry?") = vbNo Then _
                    Exit Sub Else GoTo StartAgain
        End If
       
        Sheets("Passwords").Range("A" & PwdPos).Value = PwdNew
        MsgBox "Password successfully changed." & vbLf & vbLf & _
            "You must save the workbook to make the change permanent."
    Else
        MsgBox "Password not found"
        Exit Sub
    End If
   
End Sub



MORE SHEETS PER PASSWORD:
"I have a similar need as above, but I need to unhide more than one sheet per password.  Also, I need to be able to navigate these sheets without them hiding again until I'm finished with them."

For this we do not use a ThisWorkbook macro to hide sheets, instead we put this in the main Front sheet's module to hide all the other sheets whenever we return to the Front sheet:

CODE

Option Explicit

Private Sub Worksheet_Activate()
Dim ws As Worksheet

    For Each ws In Worksheets
        If ws.Name <> Me.Name Then ws.Visible = xlSheetVeryHidden
    Next ws
   
End Sub



The Passwords page now lists passwords in column A, then as many sheetnames on the same row as you would like to unhide.

Lastly, this is the macro, stored in a standard code mudule then attached to a button (optional), to unhide the sheets:

CODE

Option Explicit

Sub PasswordChecker()
'Author:    Jerry Beaucaire, 7/21/2010,  9/4/2011
'Summary:   uses passwords in a hidden table to unhide sheets based on pwds
Dim Pwd As String, PwdPos As Long, Col As Long
Dim MySheet As String

    Pwd = Application.InputBox _
        ("Please enter a password for your sheet", "Password", Type:=2)
    If Pwd = "False" Then Exit Sub
    On Error Resume Next
    PwdPos = WorksheetFunction.Match _
            (Pwd, Sheets("Passwords").Range("A:A"), 0)
   
    If PwdPos = 0 Then
        MsgBox "No sheets are unlocked with that password."
        Exit Sub
    End If
   
    Col = 2
    Do
        Sheets(Sheets("Passwords").Cells(PwdPos, Col).Value).Visible = True
        Col = Col + 1
    Loop Until Sheets("Passwords").Cells(PwdPos, Col).Value = ""
    Sheets(Sheets("Passwords").Cells(PwdPos, 2).Value).Activate
   
End Sub




Nothing says "thanks" like a steak dinner!

PayPal - The safer, easier way to pay online!
Comments