Allow filtering to a protected workbook

Hi all,

I have a code that allows access to nominated staff only, as a "Guest" only you have no access to changing any cell content, however I want to allow the "Guest" the ability to filter...don't understand why my code still won't allow filtering? See below, as always thanks for any assistance, cheers guys - Marco

Case Else
strFullName = "Guest " & (Environ("username"))
For Each xlsWorksheet In ThisWorkbook.Worksheets
xlsWorksheet.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, _
userinterfaceonly:=True
Next xlsWorksheet
With ThisWorkbook
.Worksheets("Jan-Jun_18").Visible = xlSheetVisible
.Worksheets("Jan-Jun_18").Protect Password:=PW
.Worksheets("Jul-Dec_18").Visible = xlSheetVisible
.Worksheets("Jul-Dec_18").Protect Password:=PW
.Worksheets("Users").Visible = xlSheetVeryHidden
.Worksheets("Users").Protect Password:=PW
End With
Application.ScreenUpdating = True
End Select
MsgBox "Welcome " & strFullName & " you have " & strAccessLevel & vbCrLf & " " & vbCrLf & "", Title:="Welcome"
End Sub

You should set the code so that "UserInterfaceOnly:=True" is in the "Workbook_Open" procedure of the "ThisWorkbook" module

Hi porucha vevrkuy,

This code is in the "Workbook_Open", full code below. This should allow a non user, "Guest" to use filtering on the protected pages, but sadly this doesn't work? See below, thanks again for any advise - Marco

Private Sub Workbook_Open()
On Error Resume Next
Dim xlsUsers As Excel.Worksheet
Dim xlsWorksheet As Excel.Worksheet
Dim strAccessLevel As String
Dim strFullName As String
Dim x As Integer
Dim ws As Worksheet
Dim varUserFound As Variant
Const PW = "000"
strAccessLevel = "Read only Access"
Set xlsUsers = ThisWorkbook.Worksheets("Users")
Application.StatusBar = "Copyright MadCat Productions"
Application.ScreenUpdating = False
varUserFound = Application.Match(Environ("username"), xlsUsers.Columns("A"), 0)
If IsNumeric(varUserFound) Then
strFullName = xlsUsers.Cells(varUserFound, "B").Value
strAccessLevel = xlsUsers.Cells(varUserFound, "C").Value
End If
Select Case strAccessLevel
Case "Full Administrator Access"
For Each xlsWorksheet In ThisWorkbook.Worksheets
xlsWorksheet.Unprotect Password:=PW
Next xlsWorksheet
With ThisWorkbook
.Worksheets("Jan-Jun_18").Visible = xlSheetVisible
.Worksheets("Jan-Jun_18").Unprotect Password:=PW
.Worksheets("Jul-Dec_18").Visible = xlSheetVisible
.Worksheets("Jul-Dec_18").Unprotect Password:=PW
.Worksheets("Users").Visible = xlSheetVeryHidden
.Worksheets("Users").Protect Password:=PW

End With

Case Else
strFullName = "Guest " & (Environ("username"))
For Each xlsWorksheet In ThisWorkbook.Worksheets

xlsWorksheet.Protect Password:=PW, DrawingObjects:=True, Contents:=True, Scenarios:=True _
        , AllowFiltering:=True

Next xlsWorksheet
With ThisWorkbook
.Worksheets("Jan-Jun_18").Visible = xlSheetVisible
.Worksheets("Jan-Jun_18").Protect Password:=PW
.Worksheets("Jul-Dec_18").Visible = xlSheetVisible
.Worksheets("Jul-Dec_18").Protect Password:=PW
.Worksheets("Users").Visible = xlSheetVeryHidden
.Worksheets("Users").Protect Password:=PW
End With
Application.ScreenUpdating = True
End Select
MsgBox "Welcome " & strFullName & " you have " & strAccessLevel & vbCrLf & " " & vbCrLf & "", Title:="Welcome"
End Sub

Update:

I ended up just adding a cmdbutton with:

Sub Macro1()
Application.DisplayAlerts = False
ActiveSheet.Unprotect Password:="000"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowSorting:=True, AllowFiltering:=True
Application.DisplayAlerts = True
End Sub

Does the job nicely, thanks anyway guys - Marco