Password protection not working

CookieMonster76

Board Regular
Joined
Apr 30, 2015
Messages
180
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
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,065
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
If C4 is unlocked does it work if you move the unprotect code down?

Rich (BB code):
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

Board Regular
Joined
Apr 30, 2015
Messages
180
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
 

CookieMonster76

Board Regular
Joined
Apr 30, 2015
Messages
180

ADVERTISEMENT

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

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,065
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
When the error comes up and you click Debug which line is highlighted?
 

CookieMonster76

Board Regular
Joined
Apr 30, 2015
Messages
180

ADVERTISEMENT

.PivotItems("Village2").Visible = False
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,065
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
Does the below make any difference?

VBA Code:
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
 

MARK858

MrExcel MVP
Joined
Nov 12, 2010
Messages
14,065
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
  2. Mobile
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,169
Messages
5,640,548
Members
417,151
Latest member
ChickenTenderer

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
Top