Password Protected Sheets should be hidden until after password is enterred

jrfarmer2010

New Member
Joined
Jan 18, 2018
Messages
8
Hey there, I'm hoping for some help with my VBA code in Excel 2016. First, I know that this is not fool-proof security, but that's fine for what I'm working with. I have an excel workbook, with many hidden sheets (one for each employee), and a menu tab with buttons linking to each sheet. I have VBA code on each sheet requiring a password, but when I click the button from the menu tab, it pulls up and shows the sheet with a password box on top of it. Is there a way to hide the content of the sheet until after the password is entered? I'm not sure if this should be part of the button or the sheet code, so I've posted both below. Thanks for any help!

Here is my button code

Code:
Sub GSG_Target_Employee()
Sheets("Menu").Select
Sheets("Stellar Employee").Visible = True
Sheets("Stellar Employee").Select
End Sub

and here is my sheet code

Code:
Private Sub Worksheet_Activate()
Dim strPassword As String
On Error Resume Next
Me.Protect Password:="Test"
Me.Columns.Hidden = True
strPassword = InputBox("Enter password to access worksheet. Please contact FirstName LastName for assistance")
If strPassword = "" Then
Me.Columns.Hidden = True
Worksheets("Menu").Select
Exit Sub
ElseIf strPassword <> "Test" Then
MsgBox "The password you entered is not correct"
Me.Columns.Hidden = True
Worksheets("Menu").Select
Exit Sub
Else
Me.Unprotect Password:="Test"
Me.Columns.Hidden = False
End If
Range("a1").Select
On Error GoTo 0
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Hi,
welcome to forum

Rather than repeat all that code in each worksheet, consider a common code & pass as arguments, the sheet & password to it from each of your commandbuttons


Try following & see if helps you:

In a STANDARD module

Rich (BB code):
Sub ShowSheet(ByVal sh As Object, ByVal Password As String)
    Dim Entry As Variant
    Dim Prompt As String, Title As String
    Dim try As Integer
    Dim IsValidPassword As Boolean
    
    try = 1
    Title = "Enter Password"
    sh.Visible = xlSheetVeryHidden
    Do
        Prompt = "Please Enter Password To Continue"
        Prompt = Prompt & Chr(10) & Chr(10) & _
                  "attempt " & try & " of 3"


        Entry = InputBox(Prompt, Title)
        If StrPtr(Entry) = 0 Then Exit Do
        
        If Entry <> Password And try = 3 Then
                MsgBox "Three Attempts Only Allowed", 16, "Three Attempts Only"
                Exit Do
        ElseIf Entry <> Password Then
                MsgBox "Password invalid - Please try again", 48, "Invalid Password"
                try = try + 1
            
        Else
'Optional Success MsgBox
                'MsgBox "Password Correct - Click OK To Continue.", 64, "Password Correct"
            
                Exit Do
        End If
        
    Loop
    
    IsValidPassword = CBool(Entry = Password)
   
    Application.ScreenUpdating = False
    With sh
        .Visible = IsValidPassword
        .Unprotect Password
        .Columns.Hidden = CBool(Not .Visible)
        .Activate
        If Not .Visible Then .Protect Password
    End With
    Application.ScreenUpdating = True
End Sub


For each of your commandbuttons

Rich (BB code):
Private Sub GSG_Target_Employee_Click()
    ShowSheet sh:=Sheets("Stellar Employee"), Password:="Test"
End Sub

You change the sheet name & password shown in RED for each commandbutton as required

You will need to remove all the worksheet Activate codes.

ALWAYS MAKE A BACKUP OF YOUR WORKBOOK BEFORE TESTING NEW CODE.

Hope Helpful

Dave
 
Upvote 0
.
Let's say you have more than just a few employees .... perhaps 30 - 90 or maybe even 200. To avoid the extra work and visual displeasure of all those buttons ...

This is the main portion of the code in the UserForm (there is code in other sections of the workbook too lengthy to post here ) :

Code:
Option Explicit


Dim HFD As Integer, HFR As Integer
Dim N As Long, F As Long, Pass As String


Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Sheets("SetUp").Visible = xlSheetVisible
    For N = 3 To HFR
        If ComboBox1.Value = Sheets("SetUp").Cells(15, N).Value Then
            Exit For
        End If
    Next N
    
    If TextBox1.Value = Sheets("SetUp").Cells(16, N).Value Then
    Sheets("SetUp").Visible = xlSheetVeryHidden
    MsgBox Range("SetUp!C10").Value, , Range("SetUp!C9").Value & " " & Sheets("SetUp").Cells(15, N).Value
    Unload UserForm1
    Sheets("SetUp").Visible = xlSheetVisible
    Pass = Sheets("SetUp").Range("K12").Value
    Sheets("SetUp").Visible = xlSheetVeryHidden
    
        For F = 17 To HFD
            If UCase(Sheets("SetUp").Cells(F, N).Value) = "X" Then
                Sheets(Sheets("SetUp").Cells(F, 2).Value).Visible = xlSheetVisible
            End If
            
            If UCase(Sheets("SetUp").Cells(F, N).Value) = "P" Then
                Sheets(Sheets("SetUp").Cells(F, 2).Value).Visible = xlSheetVisible
                Sheets(Sheets("SetUp").Cells(F, 2).Value).Protect Password:=Pass
            End If
        Next F
        
    Else
    
        MsgBox Range("SetUp!C6").Value, , Range("SetUp!C7").Value
        TextBox1.Value = ""
        Sheets("SetUp").Visible = xlSheetVeryHidden
    End If
    
Application.ScreenUpdating = True
End Sub
Private Sub CommandButton2_Click()
    Unload UserForm1
End Sub
Private Sub UserForm_Initialize()
Dim WkSht As Worksheet
Application.ScreenUpdating = False


    For Each WkSht In Worksheets
        If Not WkSht.Name = "Intro" Then WkSht.Visible = xlSheetVeryHidden
    Next WkSht
        Sheets("SetUp").Visible = xlSheetVisible
        HFD = Sheets("SetUp").Range("B65536").End(xlUp).Row
        HFR = Sheets("SetUp").Range("IV15").End(xlToLeft).Column
        UserForm1.Caption = Range("SetUp!C3").Value
        Label3.Caption = Range("SetUp!C4").Value
    For N = 3 To HFR
        With ComboBox1
            .AddItem Sheets("SetUp").Cells(15, N).Value
        End With
    Next N
    
Sheets("SetUp").Visible = xlSheetVeryHidden
Application.ScreenUpdating = True
End Sub


Download example workbook : https://www.amazon.com/clouddrive/share/PggJwCR7tTRci86IFA1tHLOr26O5fLu039f7WODAZr8


In the SetUp Sheet, under each employee name is a blank cell. Enter their assigned password there. Once entered, you won't be able to see the password but if you click in the cell and look in the Formula Bar
you will see the password displayed correctly. Each cell has been formatted as CUSTOM with four semi-colons which in essence makes whatever is entered into the cell invisible. That way, if an unauthorized user
happens to gain access to the SetUp Sheet they won't see the assigned passwords.

Enjoy.
 
Last edited:
Upvote 0
You are very welcome.

I like dmt32 's solution for a small project. Very nice !
 
Upvote 0
You are very welcome.

I like dmt32 's solution for a small project. Very nice !


Very kind of you - I just stuck with the OPs requirement wanting to use commandbuttons but your suggestion of table is on reflection, the better approach.

Dave
 
Upvote 0
Very kind of you - I just stuck with the OPs requirement wanting to use commandbuttons but your suggestion of table is on reflection, the better approach.

Dave

This was my first real attempt at using significant coding in a file, and I am so thankful for both of your suggestions. This time the table worked, but I have already found another file that could be improved upon with Dave's suggestion.

Thank you again!

Jessica
 
Upvote 0
This was my first real attempt at using significant coding in a file, and I am so thankful for both of your suggestions. This time the table worked, but I have already found another file that could be improved upon with Dave's suggestion.

Thank you again!

Jessica


Glad you found suggestions helpful – a little belated but if sharing your workbook over your corporate network then there is a way to display user sheets without the need for them to login with password.

Have a look here:https://www.mrexcel.com/forum/excel...word-protect-viewing-multiple-worksheets.html

#post 3

Solution takes similar approach to that of Logit using a table (which is automatically created) but validates which sheet(s) to display by their Network UserName. This like Logit’s solution, can be more than one sheet for each user. Admin user(s) get access to all sheets and any new sheets are added to the table.

Hope of interest.

Dave
 
Upvote 0

Forum statistics

Threads
1,223,943
Messages
6,175,547
Members
452,652
Latest member
eduedu

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