speeding up pivot report VBA

[simico]

Hello all,

I need some help speeding up some VBA I have pieced together. I got the original off of www.contextures.com , to update pivot report filters from a drop down list. I just modified it to look at 3 fields instead of 1. It does indeed work as is, it just has some weird slowness.

I guess I should explain my setup. I have Windows XP and Excel 07. The page with my drop downs acts kind of like a dashboard. The three fields with drop downs make a few dozen other cells update with data, along with couple of charts. There are then two pivot tables that get updated with the VBA code. The data is coming off of another sheet with 100k rows+ of data.

Here's the problem. With no VBA active, this main page updates almost instantly when any of the three drop downs (Year, Month, Facility) changes. With the VBA active, changes to Year and Month take just a few seconds for everthing to update. Facility, however, takes a really long time (relatively), at least 20-30 seconds, which is entirely too long.

Here's the code. Any suggestions for how to speed things up would be huge!

Thanks!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim pt As PivotTable
Dim pi As PivotItem
Dim strField As String
strField = "Facility"
On Error Resume Next
Application.EnableEvents = False
Application.ScreenUpdating = False
    If Target.Address = Range("M3").Address Then
 
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
 
    End If
 
 
    strField = "Month"
On Error Resume Next
 
    If Target.Address = Range("O3").Address Then
 
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
 
    End If
 
 
    strField = "Year"
On Error Resume Next
 
    If Target.Address = Range("O2").Address Then
 
        For Each ws In ThisWorkbook.Worksheets
            For Each pt In ws.PivotTables
                With pt.PageFields(strField)
                    For Each pi In .PivotItems
                        If pi.Value = Target.Value Then
                            .CurrentPage = Target.Value
                            Exit For
                        Else
                            .CurrentPage = "(All)"
                        End If
                    Next pi
                End With
            Next pt
        Next ws
 
    End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub

 

[simico]

Does the afternoon crowd (by my time, anyway) have any suggestions on this?

 

[simico]

Happy Monday all,

Anyone have any ideas for me this week?

 

[simico]

One final bump then I'll let it die a slow death...