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

[BlissC]

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:
  

  Protecting pages from viewing using network username

  Hi everyone, I'm using this VBA script from the 3rd post on this thread: Password Protect Viewing for Multiple Worksheets (code below) to control access to different pages in my workbook, which uses the network username to control who gets to see what, and the script itself is working fine...

  www.mrexcel.com

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

ThisWorkbook

'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)
  HideSheets
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
       
        HideSheets


        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
            Else
                '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
            Worksheets(HomeSheet).Activate
            
        Else
            '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
        
myerror:
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

'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
    Next
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
            Else
                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)

Thanks,

Bliss