asked on

Unhide very hidden sheets with password

Hello,
In a workbook which I have created has 4 sheets.
Scenario 1: Sheet 1, 2 & 3 can be viewed and amended by Managers only
Scenario 2: Sheet 3 should be viewed by Team members and they should not view any other sheets
Scenario 3: Sheet 1, 2, 3 & 4 should be viewed and amended by Testers.
I have protected the sheets so cannot amend the data.
I tried very hidden option on VBA, this is perfect for Scenario 2 as users cannot unhide easily and have also protected the VBA properties with password. So even the users who know VBA cannot unhide the sheets - successful.
But the Managers would like to access sheets 1, 2 & 3 with password protection. Since I used very hidden facility in VBA the UNHIDE option remains disabled on excel :(
Is there anyway were I can make to enable the UNHIDE option on very hidden sheets and also password protect it when pressed on UNHIDE.

Please your help is much appreciated. I have done all my work on these sheets but at the end point I'm unable to deliver my file to the team due to this restriction problem, please help.

Awaiting response.

Regards & thanks
Britto

Shums Faruk

Hi Britto,

Check this Link Which is exactly what you are looking for.

If you were unable to do, please attach your sample workbook, I will edit it for you.

Roy Cox

You can give the managers a master password. Then attach a button using this code which asks for the password, if correct it unhides the sheets. Similar code can reverse visibility

Sub MasterUnhide()
    Dim oWS As Worksheet
    Dim sPW As String
    Const sMaster As String = "Secret"

    sPW = InputBox("Please enter the password")
    If Len(sPW) = 0 Then Exit Sub

    If sPW <> sMaster Then
        MsgBox "Password incorrect", vbCritical, "Quitting"
        Exit Sub
    Else: For Each oWS In ThisWorkbook
            Select Case oWS.Name
            Case "Sheet1", "Sheet2", "Sheet3"    ''/// change sheet names as required
                oWS.Visible = xlSheetVisible
            End Select
        End If
    End Sub

Open in new window

Shums Faruk

Hi Britto,

Add one more Sheet with these 4 sheets and rename it as "Login" and make sure that Sheet is 5th sheet.
Then add below code in Workbook Open Module:

Private Sub Workbook_Open()
    Dim Users As String
    
    Users = Application.InputBox("Enter Your UserName")
    
    ' following user has access to all sheets except forth
    If Users = "Manager" Then
        Sheet1.Visible = xlSheetVisible
        Sheet2.Visible = xlSheetVisible
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVeryHidden
        Sheet5.Visible = xlSheetVisible
    End If
    ' following user has access to 3rd Sheets
    If Users = "Teams" Then
        Sheet1.Visible = xlSheetVeryHidden
        Sheet2.Visible = xlSheetVeryHidden
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVeryHidden
        Sheet5.Visible = xlSheetVisible
    End If
    ' following user has access to all Sheets
    If Users = "Testers" Then
        Sheet1.Visible = xlSheetVisible
        Sheet2.Visible = xlSheetVisible
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVisible
        Sheet5.Visible = xlSheetVisible
    End If
    If Users = "" Then
        MsgBox Title:="Warning", Prompt:="Incorrect Password"
    Exit Sub
    End If
    
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
For Each ws In Me.Worksheets
    If Sheet5.Visible = xlSheetHidden Then Sheet5.Visible = xlSheetVisible
    If ws.Name <> "Login" Then ws.Visible = xlSheetHidden
Next ws
End Sub

Open in new window

Please find attached for your reference
Login-To-Access-Workbook.xlsm

Venantius Britto

ASKER

Thank you Shums & Roy for quick and kind information.
I tried the first 2 scenarios and was not successful. I followed the same method and when I save and close and re-open it is as normal - no pop-up to enter username & password and can view all the sheets.
But when I check in VBA the scripts entered remain the same.

I will now try Shum's second advise along with first now and try my luck. But can you please advise me which place are referring when you say - "add below code in workbook open module"?

Thanks.

Shums Faruk

Britto,

Press Alt+F11, When visual basic will open you will see below image;

Right Click on Workbook and paste above code
Anyway I have already attached a sample workbook, which you can try login with Passwords like:
Manager
Teams
Testers

Roy Cox

I'm at work now but I'll check when I get home. The code that I posted should work but you need to attach it to a button

Venantius Britto

ASKER

Hi Shums,
Thank you and it is excellent.... I will just rename the Username to Password and will share the unique passwords with Managers and Teams to access the file.
Great, thanks a lot.

Venantius Britto

ASKER

Thanks Roy.

Venantius Britto

ASKER

Hi Shums,
One last help can you please modify the script so that the passwords entered are encrypted... do not want other users to see the passwords typed by other members as I have different files for different teams.. so.

Shums Faruk

This is not possible with the built in Function InputBox. Else we must create UserForm.
Shall I make it?

Venantius Britto

ASKER

yes, please

Shums Faruk

Hi Britto,

Paste below code in your Normal Module:

'----------------------------------
'API CONSTANTS FOR PRIVATE INPUTBOX
'----------------------------------
Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _
    ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
    (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _
(ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _
ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'Constants to be used in our API functions
Private Const EM_SETPASSWORDCHAR = &HCC
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook As Long

'----------------------------------
'PRIVATE PASSWORDS FOR INPUTBOX
'----------------------------------

'////////////////////////////////////////////////////////////////////
'Password masked inputbox
'Allows you to hide characters entered in a VBA Inputbox.
'
'Code written by Daniel Klann
'March 2003
'////////////////////////////////////////////////////////////////////

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim RetVal
    Dim strClassName As String, lngBuffer As Long

    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If

    strClassName = String$(256, " ")
    lngBuffer = 255

    If lngCode = HCBT_ACTIVATE Then    'A window has been activated

        RetVal = GetClassName(wParam, strClassName, lngBuffer)
        
        If Left$(strClassName, RetVal) = "#32770" Then  'Class name of the Inputbox

            'This changes the edit control so that it display the password character *.
            'You can change the Asc("*") as you please.
            SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0
        End If

    End If
    
    'This line will ensure that any other hooks that may be in place are
    'called correctly.
    CallNextHookEx hHook, lngCode, wParam, lParam

End Function

Function InputBoxDK(Prompt, Title) As String
    Dim lngModHwnd As Long, lngThreadID As Long

    lngThreadID = GetCurrentThreadId
    lngModHwnd = GetModuleHandle(vbNullString)
    
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID)

    InputBoxDK = InputBox(Prompt, Title)
    UnhookWindowsHookEx hHook

End Function

Open in new window

Then Paste below in your Workbook Module:

Private Sub Workbook_Open()
    Dim Users As String
    
    Users = InputBoxDK("Enter Your UserName", "Password Required")
    
    ' following user has access to all sheets except forth
    If Users = "Manager" Then
        Sheet1.Visible = xlSheetVisible
        Sheet2.Visible = xlSheetVisible
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVeryHidden
        Sheet5.Visible = xlSheetVisible
    End If
    ' following user has access to 3rd Sheets
    If Users = "Teams" Then
        Sheet1.Visible = xlSheetVeryHidden
        Sheet2.Visible = xlSheetVeryHidden
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVeryHidden
        Sheet5.Visible = xlSheetVisible
    End If
    ' following user has access to all Sheets
    If Users = "Testers" Then
        Sheet1.Visible = xlSheetVisible
        Sheet2.Visible = xlSheetVisible
        Sheet3.Visible = xlSheetVisible
        Sheet4.Visible = xlSheetVisible
        Sheet5.Visible = xlSheetVisible
    End If
    If Users = "" Then
        MsgBox Title:="Warning", Prompt:="Incorrect Password"
    Exit Sub
    End If
    
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim ws As Worksheet
For Each ws In Me.Worksheets
    If Sheet5.Visible = xlSheetHidden Then Sheet5.Visible = xlSheetVisible
    If ws.Name <> "Login" Then ws.Visible = xlSheetHidden
Next ws
End Sub

Open in new window

Please find attached for your reference
Login-To-Access-Workbook.xlsm

Roy Cox

Here's a more complete example as promised.

Two buttons to hide or unhide the sheets. Managers will need a master password, in this example Secret.
HideUnhideSheets.xlsm

Roy Cox

I've just remembered an old example of mine. This is more professional and contains a UserForm allowing the user to enter a password and hide, delete or display sheets.

Just a note - all those API calls are not really necessary and the code will not work on 64-bit systems.
Sheet-Hider-with-Password.xlsm

Venantius Britto

ASKER

Hello Shums,
I copied the file to different path and tried as per your advise.
I went INSERT and clicked on MODULE and pasted the 1st script which is titled as "Paste below code in your Normal Module:"
Then double clicked on "ThisWorkbook" and pasted the 2nd set of script titled as "Then Paste below in your Workbook Module:"

IS THIS CORRECT?

After saving when I open the file only Login page loads and no pop-up or input box etc. Just the blank login page to view. If I again drill into VBA then I see that MODULE window/screen is not there on the left hand pane list and also "ThisWorkbook" is blank - why?
Thanks.

Roy Cox

Have you tried my examples? All those API calls are overkill to simply mask a password when you can achieve the same thing easily with a UserForm

Venantius Britto

ASKER

Hi Roy,
Infact yesterday itself I created the user form but don't know how to link the user form to the workbook and make it active as expected.
I also tried the attachments which had recently sent but unable to ENABLE EDITING as I receive the attached message.
enable-editing.JPG

Roy Cox

Not sure what the error message is. Just uploaded again and it downloads and works perfectly.

I'm off to work now but I will be back later and see if you still have problems
Sheet-Hider-with-Password.xlsm

Venantius Britto

ASKER

I have no luck with it.. it is the same for me...

Unable to go ahead with your advise.

ASKER CERTIFIED SOLUTION

Shums Faruk

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

Venantius Britto

ASKER

Excellent, thanks Shums.
You really helped me a lot guiding step by step and was able to achieve what I was trying to do..
Great work.. thanks once again

Shums Faruk

You're Welcome Britto! Glad I was able to help