Password protection worksheet Excel VBA

Question

I am trying to provide a minor form of access protection to multiple sheets in an Excel workbook. I understand this isn't easy to achieve and there will still be issues with protection.

I have working code below on how I want to achieve this. However, it will only work on one sheet in the workbook. Is there a way to add multiple sheets to this code.

Note: I don't wan't to create multiple versions of the same workbook. I just want a simple password to access the sheet. I understand this doesn't provide a foolproof method or restricting access

Private Sub Workbook_Open()

End Sub

    Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim MySheetName As String

    MySheetName = "Sheet1" 'The first sheet which I want to hide.
    MySheetName = "Sheet2" 'The second sheet which I want to hide.

    If Application.ActiveSheet.Name = MySheetName Then
        Application.EnableEvents = False
        Application.ActiveSheet.Visible = False
        response = Application.InputBox("Password", "Enter Password", "", Type:=2)

            If response = "1234" Then 'Unhide Password.
                Application.Sheets(MySheetName).Visible = True
                Application.Sheets(MySheetName).Select
            End If
    End If

    Application.Sheets(MySheetName).Visible = True

    Application.EnableEvents = True
    End Sub

This code will only work on a single worksheet. Can it be adapted to provide protection on multiple sheets?

Answer 1

I think this is what you are looking after. You need a collection, or, more generally, a data structure that can hold multiple values. From here, you compare your list of values against the currently activated sheet.

Option Explicit
Private PreviousSheet As Worksheet

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    Dim SheetNames As Collection: Set SheetNames = New Collection
    Dim SheetName  As Variant
    Dim response   As String
    Dim ws         As Excel.Worksheet

    'List of sheet names you want to hide
    SheetNames.Add "Sheet1"
    SheetNames.Add "Sheet2"

    For Each SheetName In SheetNames
        On Error Resume Next
        Set ws = ThisWorkbook.Worksheets(SheetName)
        On Error GoTo 0

        If Not ws Is Nothing Then
            If ws.Name = Sh.Name Then
                Application.EnableEvents = False

                response = Application.InputBox("Password", "Enter Password", "", Type:=2)

                If response = "1234" Then
                    ws.Visible = xlSheetVisible
                    ws.Activate
                ElseIf response = "False" Or response = vbNullString Then
                    If Not PreviousSheet Is Nothing Then PreviousSheet.Activate
                Else
                    ws.Visible = xlSheetHidden
                End If

            End If

            Application.EnableEvents = True
        End If
    Next

End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    Set PreviousSheet = Sh
End Sub

Answer 2

Here's the really quick & dirty way.

MySheetName = "Sheet1 Sheet2 Sheet_Named_Fred"

....just list all the sheet names with a space (or anything else) between them.

Then replace your line If Application.ActiveSheet.Name = MySheetName Then

With

If Instr(MySheetName,Sh.Name)>0 Then

If you prefer, use "Application.Activesheet.Name" instead of my "Sh.Name". "Sh" is the parameter passed to that standard event function, and is the worksheet that's just been activated, so your code will look a little cleaner if you replace "Application.ActiveSheet.Name" with "Sh.name" throughout.

The "INSTR" function returns >0 if the second string appears anywhere in the first string (specifically, the character position number). So if the activesheet name appears anywhere at all in the long string of sheet names, it'll be subjected to your password test.

This is "quick and dirty" because it will fail if any of your worksheet names are substrings of another worksheet name. For instance, if you have worksheets named "Totals" and "GrandTotals", then if you put "GrandTotals" in your long string, then activating "Totals" will ALSO trigger the INSTR function. [code removed] I've just edited this to remove code that does it "for sure" by checking against an array of worksheet names. Others below are suggesting a collection or other data structure. But there's a simple way to failure-proof the above simplest solution. It's not allowed to use a * (or several other characters) in a worksheet name. So the string of password-needing names can just be:

MySheetName = "*Sheet1*  *Sheet2*  *Sheet_Named_Fred*"

And then your INSTR search for the name just needs asterisks on either side of the sheet name:

IF INSTR(MySheetName, "*"+Sh.Name+"*")>0 Then

...and you're done. No collections or other complex name searches needed.