Password protection not working

[CookieMonster76]

Hi

I have picked this up that someone else has created, and it gives the result it is designed to do (I don't know if it's the best way to do it, but i'm ignoring that for now). It runs off a drop down menu, so if you select Village1 from the list, it refreshes the pivot table and returns data relating to Village 1.

My issue is that I have been asked to password protect the sheet, which i have done. However, as the cells become locked, the code fails. So i have added in the 2 red lines, to basically unprotect it, do what it needs to do, and then re-protect it. However, it isn't unprotecting it, and then fails at the point it tries to refresh the pivot table.

Any advice greatly appreciated.

Thanks

Paul


Private Sub Worksheet_Change(ByVal Target As Range)

ActiveSheet.Unprotect Password:="safe"

Dim KeyCells As Range
Set KeyCells = Range("C4")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

chosenvillage = Range("c4").Value

With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
.PivotItems("Village1").Visible = True
.PivotItems("Village2").Visible = False
.PivotItems("Village3").Visible = False
.PivotItems("Village4").Visible = False
End With

With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
.PivotItems(chosenvillage).Visible = True
End With

If chosenvillage = "Village1" Then GoTo HERE

With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
.PivotItems("Village1").Visible = False
End With

HERE:

' Sheets("AC").Select
' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1
' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1, Criteria1:= _
' chosenvillage
' Sheets("Contract Mgt Portal").Select


End If

ActiveSheet.Protect Password:="safe"

End Sub

 

[MARK858]

If C4 is unlocked does it work if you move the unprotect code down?

Private Sub Worksheet_Change(ByVal Target As Range)



    Dim KeyCells As Range
    Set KeyCells = Range("C4")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then

        ActiveSheet.Unprotect Password:="safe"

        chosenvillage = Range("c4").Value

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems("Village1").Visible = True
            .PivotItems("Village2").Visible = False
            .PivotItems("Village3").Visible = False
            .PivotItems("Village4").Visible = False
        End With

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems(chosenvillage).Visible = True
        End With

        If chosenvillage = "Village1" Then GoTo HERE

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems("Village1").Visible = False
        End With

HERE:

        ' Sheets("AC").Select
        ' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1
        ' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1, Criteria1:= _
        ' chosenvillage
        ' Sheets("Contract Mgt Portal").Select


    End If

    ActiveSheet.Protect Password:="safe"

End Sub

 

[CookieMonster76]

Hi

Thanks

It does, yes to a point.

It works if i stop it running the last line, putting the password back on. I'm guessing that this line also needs to go somewhere else?

Thanks again

Paul

 

[MARK858]

It works if i stop it running the last line, putting the password back on

What happens if you don't stop it?

 

[CookieMonster76]

Run-Time error '1004':
Unable to set the Visible property of the PivotItem class

 

[MARK858]

When the error comes up and you click Debug which line is highlighted?

 

[CookieMonster76]

.PivotItems("Village2").Visible = False

 

[MARK858]

Does the below make any difference?

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim KeyCells As Range
    
    Set KeyCells = Range("C4")
    Set mySht = ActiveSheet
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
        mySht.Unprotect Password:="safe"
        
        For Each pt In mySht.PivotTables
            pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
        Next

        chosenvillage = Range("c4").Value

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems("Village1").Visible = True
            .PivotItems("Village2").Visible = False
            .PivotItems("Village3").Visible = False
            .PivotItems("Village4").Visible = False
        End With

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems(chosenvillage).Visible = True
        End With

        If chosenvillage = "Village1" Then GoTo HERE

        With ActiveSheet.PivotTables("ServiceProvisions").PivotFields("LocationName")
            .PivotItems("Village1").Visible = False
        End With

HERE:

        ' Sheets("AC").Select
        ' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1
        ' ActiveSheet.ListObjects("AC").Range.AutoFilter Field:=1, Criteria1:= _
        ' chosenvillage
        ' Sheets("Contract Mgt Portal").Select


    End If

    mySht.Protect Password:="safe"
  
End Sub

 

[CookieMonster76]

No, same result

It seems to work if is move the unprotect line before "End if"

 

[MARK858]

I thought of that earlier but couldn't see a reason why it wasn't reaching the line. If it works then test and go with it as it won't do any harm being there.