VBA that worked in Excel 2003 which doesn't in Excel 2016

[Andy13]

Hi all, I've been trying to fix this one myself with a little research and trial and error, but I've drawn a blank.

I inherited some VBA that used to unprotect a worksheet, refresh some pivot tables, got to the pivot table in the current sheet, colour a range (to show that the worksheet was locked), and then re-protect the worksheet. The is repeated in different subs to refresh and display different pivot tables, eight in all. The workbook has multiple worksheets, each worksheet identical in design but displaying different data.

At least that's what it did before we upgraded our Excel version a couple of weeks ago.

Now the code does everything it did before, but instead of showing the pivot table on the current sheet, it jumps to the same pivot table on a different worksheet.

I assume the current worksheet is no longer the active worksheet. But I'm afraid my knowledge is limited.

Code is as follows.

Sub Trans()

Application.ScreenUpdating = False
Dim ws As Worksheet
Dim pt As PivotTable
Dim ptCache As PivotCache
Dim Pwd As String
        
   For Each ws In Worksheets
        ws.Unprotect Password:="password"
   Next ws
   
   
   With ActiveSheet
        For Each pt In .PivotTables
        pt.RefreshTable
        
        Set pt = ActiveSheet.PivotTables("Pivot1")
        For Each PivotItem In pt.PivotFields("Transition").PivotItems
           If PivotItem.Value = "(blank)" Then PivotItem.Visible = False
        Next PivotItem
        Next pt
   End With
   
Application.ScreenUpdating = True
    
ActiveWorkbook.ShowPivotTableFieldList = False
Range("M12435").Select
Range("J7:K11").Interior.ColorIndex = 3


For Each ws In Worksheets
        ws.Protect Password:="password", DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
Next ws


End Sub

Many thanks for any help or advice you could possibly provide.

 

[baitmaster]

welcome to the board

- You're looping through each worksheet and unprotecting it
- Then you're looking at only the activesheet (which is whichever sheet is currently on screen) and playing with the pivot tables
- Then you're looping through each worksheet again and reprotecting it


The reason you're using activesheet is so that you have a worksheet object on which you can perform certain actions, but you already have a more-specific worksheet object WS which is probably better. I think you therefore want to change your algorithm something like this:

For each WS in Worksheets
    with ws ' note that I'm not using activesheet anywhere, everything beginning .dot now refers to the WS worksheet instead of activesheet
        .unprotect

        ' play with pivot tables
        for each pt in .PivotTables

        next pt

    .protect
    end with
next WS

As an aside you can also get rid of the unprotect/protect routines, by running an unprotect/protect routine once when you open the file, which sets userInterfaceOnly = True when you protect; this prevents changes by the User but allows changes by VBA

Hope this helps

 

[Andy13]

baitmaster,

Many thanks.

I'm afraid my VBA skills are seriously lacking; I've commented out everything relating to the unprotect/protect routine but I now get a 400 error. Deleting it returns the same message. What am I misisng?

 

[baitmaster]

I can only guess at what your file looks like so I can't test this code, but I imagine you want something like this

Sub Trans()
'Application.ScreenUpdating = False ' I've disabled this feature during development
Dim ws As Worksheet
Dim pt As PivotTable
Dim ptCache As PivotCache ' this variable is obsolete
Const Pwd As String = "password" ' password added as a constant so it only needs to be entered once
' loop through all worksheets to repeat the following process
For Each ws In Worksheets
    
    With ws
        
        ' unprotect this worksheet using standard password
        .Unprotect Password:=Pwd
        
        ' loop through every pivot table on worksheet
        For Each pt In .PivotTables
            
            ' refresh it
            pt.RefreshTable
            
            ' create an object called pt that is always "Pivot1" - note, this is probably wrong
            Set pt = .PivotTables("Pivot1") ' I think this line should be deleted
            
            ' loop through a number of items in the pivot table and hide them if blank
            For Each PivotItem In pt.PivotFields("Transition").PivotItems
               If PivotItem.Value = "(blank)" Then PivotItem.Visible = False
            Next PivotItem
        
        Next pt
        
        ' add colour to a very specific range of cells. I've added "." to the start so it applies to every worksheet, else it only does it on the activeworksheet, a number of times
        .Range("J7:K11").Interior.ColorIndex = 3
        
        ' reprotect worksheet using same password
        .Protect Password:=Pwd, DrawingObjects:=True, Contents:=True, Scenarios:=True, _
        AllowDeletingRows:=True, AllowInsertingRows:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
        
    End With
    
Next ws
' hide the pivot table window - feature moved outside of worksheets loop
ActiveWorkbook.ShowPivotTableFieldList = False
'Application.ScreenUpdating = True
End Sub