VBA protection from viewing sheets/sheet protection locking slicers and timelines


New Member
Aug 28, 2017
Office Version
  1. 365
  2. 2019
  1. Windows
Hi everyone,

I'm having an issue with a VBA script originally written by forum member dmt32, which I'm successfully using on a couple of my spreadsheets, but I've run into a problem with it on my current project. The VBA uses a table created by the script to specify users who are able to access specific sheets in the workbook, and with a couple of slight tweaks also enables the sheet protection to stop users accidentally overwriting formulas etc. This has worked fine on my other projects, but I've hit a snag with this one because most of the sheets have slicers/pivot tables/timelines, and when the various macros run, while it protects everything that needs protecting, it's also locking the slicers/pivot tables/timelines.

These two threads provide the background to me using the VBA code:
  • Password protect viewing for multiple worksheets: Password Protect Viewing for Multiple Worksheets
  • Protecting pages from viewing using network username:

...and this is the code I'm using:

VBA Code:
'Original code by dmt32 @ MrExcel.com forum
'Thread: Password protect Viewing for Multiple Worksheets
'URL: https://www.mrexcel.com/board/threads/password-protect-viewing-for-multiple-worksheets.937247/

Private Sub Workbook_BeforeClose(Cancel As Boolean)
End Sub

Private Sub Workbook_Open()
    Dim Admin As Boolean
    Dim msg As Variant
    Dim LastCol As Integer, c As Integer
    Dim rng As Range
    Dim sh As Worksheet, UserList As Worksheet

    On Error GoTo myerror
        ThisWorkbook.Sheets(HomeSheet).Visible = xlSheetVisible

        Set UserList = UserTable("User List")
        With UserList
            .Unprotect Password:=shPassword
            lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
            Set rng = .Range("A2:A" & lastrow)
        End With

    'check valid user
    If IsValidUser(rng, Admin) Then
            Application.ScreenUpdating = False
            'Admin User unhide all sheets
            If Admin Then
                For Each sh In ThisWorkbook.Worksheets
                    sh.Visible = xlSheetVisible
                    sh.Protect Password:=shPassword 'changed from Unprotect in original code to make sure sheets maintain protection
                Next sh
                'unhide user sheets
                With UserList
                    For c = 3 To LastCol
                        If UCase(.Cells(rng.Row, c).Value) = "X" Then
                            With Sheets(.Cells(1, c).Value)
                                .Visible = xlSheetVisible
                                .Protect Password:=shPassword 'changed from Unprotect in original code to make sure sheets maintain protection
                            End With
                        End If
                    Next c
                   If Len(shPassword) > 0 Then .Protect Password:=shPassword
                End With
            End If
            'activate home sheet
            'user not valid
            If Len(shPassword) > 0 Then UserList.Protect Password:=shPassword
            MsgBox "You Do Not Have Access To This File", 16, "Access Invalid"
            ThisWorkbook.Close False
        End If
Application.ScreenUpdating = True
If Err > 0 Then MsgBox (Error(Err)), 48, "Error"

End Sub

Private Sub Workbook_SheetActivate(ByVal sh As Object)
    If sh.Name = "User List" Then BuildTable ws:=sh
End Sub

Standard Module
VBA Code:
'add password as required
Public Const shPassword As String = "password" ' Not the actual password I'm using! ;-) 
   'change Main sheet name as required
Public Const HomeSheet As String = "Welcome"

Function IsValidUser(ByRef Target As Range, ByRef Admin As Boolean) As Boolean
'function looks for valid username in user list worksheet
    Dim FindCell As Range

    Set FindCell = Target.Find(Environ("USERNAME"), LookIn:=xlValues, lookat:=xlWhole)
    If Not FindCell Is Nothing Then
        Admin = FindCell.Offset(0, 1)
        Set Target = FindCell
        IsValidUser = True
    End If

End Function

Sub BuildTable(ByVal ws As Object)
'builds table of all worksheets available in workbook
'table is updated if new sheets are added when activated
'by an admin user.
    Dim sh As Worksheet
    Dim LastCol As Long
    Dim m As Variant

        With ws
            .Unprotect Password:=shPassword
            LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column + 1
        End With

        'add sheet names to row 1
        For Each sh In Worksheets
            Select Case sh.Name
            Case HomeSheet, "User List"

            Case Else
            On Error Resume Next
            m = Application.Match(sh.Name, ws.Cells(1, 1).Resize(1, LastCol), False)
            If IsError(m) Then ws.Cells(1, LastCol).Value = sh.Name: LastCol = LastCol + 1
            End Select
End Sub

Function UserTable(ByVal SheetName As String) As Worksheet
'Function sets object reference to User List worksheet
'if it does not exist it is added
    On Error Resume Next
        Set UserTable = ThisWorkbook.Worksheets(SheetName)
        If UserTable Is Nothing Then
        Application.ScreenUpdating = False
        Set UserTable = Worksheets.Add(after:=Worksheets(1))
        With UserTable
            .Name = "User List"
            .Range("A1:B1").Value = Array("User Name", "Admin")
            .Columns(1).ColumnWidth = 15
            .Columns(2).ColumnWidth = 8
            .Range("A2").Value = Environ("USERNAME")
            .Range("B2").Value = True
          End With
          'build table
          BuildTable ws:=UserTable
        End If
    On Error GoTo 0
End Function

Sub HideSheets()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Worksheets
            If sh.Name = HomeSheet Then
                'do nothing
                sh.Visible = xlSheetVeryHidden
               If Len(shPassword) > 0 Then sh.Protect Password:=shPassword
            End If
    Next sh
End Sub

When I set the sheet protection manually while putting together the workbook, so the slicers, pivot table and timeline would still function, on the list of actions all users are allowed to do, I selected:
  • Select locked cells
  • Select unlocked cells
  • Sort
  • Use Autofilter
  • Use PivotTable & PivotChart
  • Edit objects
This allowed the sheets to be locked, but the users still to filter and use the slicers, pivot table, and timeline.

My question is, is there a way to get the VBA to specify that these options should be allowed? My VBA skills are 'just enough to be dangerous!' ;) I know enough to understand what it's doing when I see it, and to be able to make very minor tweaks, but not enough to write it myself.

(btw, if it's relevant I'm using Office 365)



Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Forum statistics

Latest member

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