Protecting and filtering

[EliseFreedman]

I am using the following code to allow users to filter records in a spreadsheet.

I have the filter criteria on one sheet with checkboxes to select which filter you want to use. I want the main report to be protected so that users cant mess with it. When they click the button to run the filter, I want the report sheet to be unprotected, the filter to run and then the report sheet to be protected again. I have tried adding code at the start of the function to unprotect the worksheet then later to protect it again and also tried a separate function to unprotect the sheet (Sheets("REPORT").Unprotect Password:="cardinus", _
UserInterFaceOnly:=True). If I do it as part of the code below I get a Run Time Error. If I do it as a separate function called before the autofilter code, it doesn't even seem to run the code(I added a msgbox to test").

Does anyone know what I am doing wrong

Sub Copy_With_AutoFilter1()

'Note: This macro use the function LastRow
    Dim My_Range As Range
    Dim CalcMode As Long
    Dim ViewMode As Long
    Dim FilterCriteria As String
    Dim CCount As Long
    Dim WSNew As Worksheet
    Dim WBNew As Workbook
    Dim sheetName As String
    Dim rng As Range
    Dim Criteria1 As String
    Dim Criteria2 As String
    Dim Criteria3 As String
    Dim Criteria4 As String
     Dim Criteria6 As String
    Dim CheckBox10 As Shape
     Dim CheckBox11 As Shape
     Dim CheckBox12 As Shape
      Dim CheckBox17 As Shape
         Dim CheckBox20 As Shape
          Dim CheckBox24 As Shape
Sheets("REPORT FILTER").Select
Criteria1 = ActiveSheet.Range("H4")
Criteria2 = ActiveSheet.Range("H8")
Criteria3 = ActiveSheet.Range("H2")
Criteria4 = ActiveSheet.Range("H10")
Criteria5 = ActiveSheet.Range("H12")
Criteria6 = ActiveSheet.Range("H14")
    'Set filter range on ActiveSheet: A11 is the top left cell of your filter range
    'and the header of the first column, D is the last column in the filter range.
    'You can also add the sheet name to the code like this :
    'Worksheets("Sheet1").Range("A11:D" & LastRow(Worksheets("Sheet1")))
    'No need that the sheet is active then when you run the macro when you use this.
    Sheets("REPORT").Select
    Set My_Range = Range("A8:AJ" & LastRow(ActiveSheet))
    My_Range.Parent.Select

    If ActiveWorkbook.ProtectStructure = True Or _
       My_Range.Parent.ProtectContents = True Then
        MsgBox "Sorry, not working when the workbook or worksheet is protected", _
               vbOKOnly, "Copy to new worksheet"
        Exit Sub
    End If

    'Change ScreenUpdating, Calculation, EnableEvents, ....
    With Application
        CalcMode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView
    ActiveSheet.DisplayPageBreaks = False

    'Firstly, remove the AutoFilter
    My_Range.Parent.AutoFilterMode = False

    'Filter and set the filter field and the filter criteria :
    'This example filter on the first column in the range (change the field if needed)
    'In this case the range starts in A so Field 1 is column A, 2 = column B, ......
    'Use "<>Netherlands" as criteria if you want the opposite
    'My_Range.AutoFilter Field:=1, Criteria1:="=Netherlands"

    'If you want to filter on a cell value you can use this, use "<>" for the opposite
    'This example uses the activecell value
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & ActiveCell.Value

    'This will use the cell value from A2 as criteria
    
   
'Function
Set CheckBox11 = Sheets("REPORT FILTER").Shapes("Check Box 11") 'Change the CheckBox number you want to check

If CheckBox11.OLEFormat.Object.Value = 1 Then
        My_Range.AutoFilter Field:=7, Criteria1:="=" & Criteria1
   
        End If
        
  
'Training Status
Set CheckBox12 = Sheets("REPORT FILTER").Shapes("Check Box 12") 'Change the CheckBox number you want to check

If CheckBox12.OLEFormat.Object.Value = 1 Then
 My_Range.AutoFilter Field:=10, Criteria1:="=" & Criteria2

 End If
 
   
'Risk Assessment Status
Set CheckBox20 = Sheets("REPORT FILTER").Shapes("Check Box 20") 'Change the CheckBox number you want to check

If CheckBox20.OLEFormat.Object.Value = 1 Then
 My_Range.AutoFilter Field:=13, Criteria1:="=" & Criteria5

 End If
 
'Site
Set CheckBox10 = Sheets("REPORT FILTER").Shapes("Check Box 10") 'Change the CheckBox number you want to check

If CheckBox10.OLEFormat.Object.Value = 1 Then

  My_Range.AutoFilter Field:=5, Criteria1:="=" & Criteria3
  End If
'Passport Level
 Set CheckBox17 = Sheets("REPORT FILTER").Shapes("Check Box 17") 'Change the CheckBox number you want to check

If CheckBox17.OLEFormat.Object.Value = 1 Then

  My_Range.AutoFilter Field:=11, Criteria1:="=" & Criteria4
  End If
  
  'DSE RISK Status
   Set CheckBox24 = Sheets("REPORT FILTER").Shapes("Check Box 24") 'Change the CheckBox number you want to check

If CheckBox24.OLEFormat.Object.Value = 1 Then

  My_Range.AutoFilter Field:=14, Criteria1:="=" & Criteria6
  End If

    ''If you want to filter on a Inputbox value use this
    'FilterCriteria = InputBox("What text do you want to filter on?", _
     '                              "Enter the filter item.")
    'My_Range.AutoFilter Field:=1, Criteria1:="=" & FilterCriteria

    'Check if there are not more then 8192 areas(limit of areas that Excel can copy)
    CCount = 0
    On Error Resume Next
    CCount = My_Range.Columns(1).SpecialCells(xlCellTypeVisible).Areas(1).Cells.Count
    On Error GoTo 0
    If CCount = 0 Then
        MsgBox "There are more than 8192 areas:" _
             & vbNewLine & "It is not possible to copy the visible data." _
             & vbNewLine & "Tip: Sort your data before you use this macro.", _
               vbOKOnly, "Copy to worksheet"
    Else
        'Add a new Worksheet
        Set WSNew = Worksheets.Add(After:=Sheets(ActiveSheet.Index))
        'Ask for the Worksheet name
         sheetName = "SHE Training Report Extract"
        On Error Resume Next
        WSNew.Name = sheetName
        If Err.Number > 0 Then
            MsgBox "Change the name of sheet : " & WSNew.Name & _
                 " manually after the macro is ready. The sheet name" & _
                 " you fill in already exists or you use characters" & _
                 " that are not allowed in a sheet name."
            Err.Clear
        End If
        On Error GoTo 0

        'Copy/paste the visible data to the new worksheet
        My_Range.Parent.AutoFilter.Range.Copy
        With WSNew.Range("A1")
            ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
            ' Remove this line if you use Excel 97
            .PasteSpecial Paste:=8
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            .Select
        End With

        ' If you want to delete the rows that you copy, also use this
        ' With My_Range.Parent.AutoFilter.Range
        '     On Error Resume Next
        '     Set rng = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
              '               .SpecialCells(xlCellTypeVisible)
        '     On Error GoTo 0
        '     If Not rng Is Nothing Then rng.EntireRow.Delete
        ' End With

    End If

    'Close AutoFilter
    My_Range.Parent.AutoFilterMode = False

    'Restore ScreenUpdating, Calculation, EnableEvents, ....
    My_Range.Parent.Select
    ActiveWindow.View = ViewMode
    If Not WSNew Is Nothing Then WSNew.Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

With WSNew.Range("A1")
           WSNew.Move
End With

End Sub

 

[combo]

Code to protect user interface only has different syntax:
[pre]Workheets("REPORT").Protect Password:="cardinus", UserInterFaceOnly:=True[/pre]
This kind of protection is not saved, so you have to execute the code every time you open workbook.
The [tt]Protect[/tt] method has other arguments too, you can for instance allow autofilter in protected sheet too (this can be selected in protection dialog and is saved).

It's hard to guess why your prodedure does not execute, how do you call it?

combo

 

[EliseFreedman]

I have tried that code

MsgBox "unprotecting"
Worksheets("REPORT").Select
Worksheets("REPORT").Unprotect Password:="cardinus", _
    UserInterFaceOnly:=True

It is running now but I get run time error "application defined or user defined error"

 

[combo]

No Unprotect, protect again with UserInterfaceOnly set to True.

combo