Make cell contents invisible until password is entered

ipec

New Member
Joined
Dec 5, 2005
Messages
3
I have added the following code to an excel doc that requires two levels of access. This part works great, but we've found that if the user clicks and holds down the left mouse button over a worksheet tab, they can view the document and are not presented with the password req until the mouse button is released.

I've tried various methods to get around this but my knowledge of vbscript with Excel just isn't what I'd like it to be. I've tried hiding the cells, hiding the worksheet until the password is entered correctly, and some other steps that didn't work out though I can't rule out that it isn't possible. I've considered forcing the cells to use a different format (;;;) or making them use a background color that is the same as the font and this would be a fine solution except it seems that it would be very difficult to implement since there are various colors of fonts and cell backgrounds that would somehow have to be recorded and replaced back to normal upon the correct password being entered.

This is just some of the background on what I've tried. Ultimately, I just want the user to not be able to see anything until a password is entered, even if they hold the mouse button down on the tab.

Here's the code:

Code:
Dim LockedSheets As Object
Dim LastActiveSheet As Worksheet
Dim S As Worksheet
Dim TempSheetVar As Worksheet
Dim UserInput As Variant
Const PWord1 As String = "pass1"
Const PWord2 As String = "pass2"
Const Msg1 As String = " is password protected" & vbNewLine _
& vbNewLine & "Please enter a valid password to enable viewing"
Const Msg2 As String = "Incorrect Password!"


Private Sub Workbook_BeforeClose(Cancel As Boolean)
    On Error Resume Next
    Application.ScreenUpdating = False
    For Each S In LockedSheets
        S.Visible = xlvryhidden
    Next S
    Me.Save 'This is to ensure hiding sheets is saved
End Sub


Private Sub Workbook_Open()
    On Error Resume Next
    Worksheets("HOME").Activate
    Application.ScreenUpdating = False
    ' ADD SHEET NAMES USING THE PATTERN BELOW TO ADD PASSWORDS TO NEW SHEETS
    Set LockedSheets = Worksheets(Array("BUDGET", "IMPORT", "COS", "PAYROLL", "RESIN", "STD", "ALLOC", "REV", "INDICATOR", "26FTV", "28FTV", "26SFV", "28SFV", "38ISC", "38ISS", "38ISO", "38ITC", "38IPP", "38TPD", "38TPC", "38ISU", "5GLIN", "38ITC F", "38ISO F"))
    For Each S In LockedSheets
        S.Visible = True
    Next S
End Sub


Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    On Error Resume Next
    Set TempSheetVar = LockedSheets(Sh.Name)
    Set TempSheetVar = Nothing
    If Err.Number = 9 Then ' if Sh out of range store it in a global var
        Err.Clear
        Application.ScreenUpdating = False
        Set LastActiveSheet = Sh
    End If
End Sub


Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    On Error Resume Next
    Set TempSheetVar = LockedSheets(Sh.Name)
    If Err.Number = 0 Then
        With Application
            .EnableEvents = False
            Sh.Visible = False
            LastActiveSheet.Activate
            .EnableEvents = True
        End With
        PromptForPassword TempSheetVar
        Set TempSheetVar = Nothing
    End If
    Err.Clear
End Sub


Sub PromptForPassword(LockedWorkSheet As Worksheet)
    With Application
        Do
            UserInput = .InputBox("'" & LockedWorkSheet.Name & "'" & Msg1)
            Select Case UserInput
                Case Is = False ' if user cancels don't activate sheet
                    Exit Do
                Case Is = PWord1 '  if password correct activate sheet
                    ' ALL OF THE WORKSHEETS THAT ACCEPT PWord1 MUST BE LISTED BELOW
                    If LockedWorkSheet.Name = "BUDGET" Or LockedWorkSheet.Name = "IMPORT" Or LockedWorkSheet.Name = "COS" Or LockedWorkSheet.Name = "PAYROLL" Or LockedWorkSheet.Name = "RESIN" Or LockedWorkSheet.Name = "STD" Or LockedWorkSheet.Name = "ALLOC" Or LockedWorkSheet.Name = "REV" Or LockedWorkSheet.Name = "INDICATOR" Or LockedWorkSheet.Name = "26FTV" Or LockedWorkSheet.Name = "28FTV" Or LockedWorkSheet.Name = "26SFV" Or LockedWorkSheet.Name = "28SFV" Or LockedWorkSheet.Name = "38ISC" Or LockedWorkSheet.Name = "38ISS" Or LockedWorkSheet.Name = "38ISO" Or LockedWorkSheet.Name = "38ITC" Or LockedWorkSheet.Name = "38IPP" Or LockedWorkSheet.Name = "38TPD" Or LockedWorkSheet.Name = "38TPC" Or LockedWorkSheet.Name = "38ISU" Or LockedWorkSheet.Name = "5GLIN" Or LockedWorkSheet.Name = "38ITC F" Or LockedWorkSheet.Name = "38ISO F" Then
                        Set LastActiveSheet = LockedWorkSheet
                        Exit Do
                    End If
                Case Is = PWord2 '  if password correct activate sheet
                    ' ALL OF THE WORKSHEETS THAT ACCEPT PWord2 MUST BE LISTED BELOW
                    If LockedWorkSheet.Name = "26FTV" Or LockedWorkSheet.Name = "28FTV" Or LockedWorkSheet.Name = "26SFV" Or LockedWorkSheet.Name = "28SFV" Or LockedWorkSheet.Name = "38ISC" Or LockedWorkSheet.Name = "38ISS" Or LockedWorkSheet.Name = "38ISO" Or LockedWorkSheet.Name = "38ITC" Or LockedWorkSheet.Name = "38IPP" Or LockedWorkSheet.Name = "38TPD" Or LockedWorkSheet.Name = "38TPC" Or LockedWorkSheet.Name = "38ISU" Or LockedWorkSheet.Name = "5GLIN" Or LockedWorkSheet.Name = "38ITC F" Or LockedWorkSheet.Name = "38ISO F" Then
                        Set LastActiveSheet = LockedWorkSheet
                        Exit Do
                    End If
                Case Else 'if wrong password give user another try
                    UserDecision = MsgBox(Msg2, vbRetryCancel): Beep
                End Select
        Loop Until UserDecision = vbCancel
        LockedWorkSheet.Visible = True
        .EnableEvents = False
        LastActiveSheet.Activate
        .EnableEvents = True
    End With
End Sub
 

Some videos you may like

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
The best way is to protect and hide the worksheet and have a button on another sheet to get the password/unhide
 

ipec

New Member
Joined
Dec 5, 2005
Messages
3
I started building such a process but the sheet had to be unhidden before I could process the password request, defeating the purpose. Do you know of a way to pop up the pw req without having to unhide the sheet?
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
I do not think it is possible to protect a sheet with 100% saftety.

Try this code which runs whenever there is an attempt to activate the sheet. The problem then is that it needs the password every time.Bear in mind that this is not "proper" password prtotection.

There is some code below that I use to toggle visibility - but this does not stop someone using Format/Sheet/Unhide.

Need to password protect the code modules.
Code:
'- macro to keep worksheet hidden
'- put into sheet module (right click tab/View Code)
'------------------------------------------------------
Private Sub Worksheet_Activate()
    Dim ws As Worksheet
    Dim MyPassword As String
    Dim ThisSheetName As String
    '----------------------------------------------
    MyPassword = "test"
    ThisSheetName = "Sheet1"
    '- hide this worksheet
    ActiveSheet.Visible = False
    rsp = InputBox("Enter Password ")
    If rsp <> MyPassword Then Exit Sub
    '- make sheet visible
    Set ws = Worksheets(ThisSheetName)
    ws.Visible = True
    Application.EnableEvents = False
    ws.Activate
    Application.EnableEvents = True
End Sub

Code:
'- reverse existing state
Sub HIDE_UNHIDE()
    With Worksheets("Sheet1")
        If .Visible = False Then
            .Unprotect password:="test"
            .Visible = True
        Else
            .Visible = False
            .Protect password:="test", _
            DrawingObjects:=True, Contents:=True, Scenarios:=True
        End If
    End With
End Sub
 

ipec

New Member
Joined
Dec 5, 2005
Messages
3
Thank you for submitting this potential solution. I inserted the code your provided in to a test worksheet. Unfortuantely, it suffers the same problem as my code: if the user holds down the left mouse button over the sheet tab, the sheet is viewable until the mouse button is released.
 

BrianB

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
The idea was to hide the sheet first so it needs the "password" to open.
This also seems to prevent Format/Sheet/Unhide.
 

Watch MrExcel Video

Forum statistics

Threads
1,119,137
Messages
5,576,300
Members
412,716
Latest member
thviid
Top