VBA loop Pivot table - speed up.

kifin

New Member
Joined
Jan 17, 2014
Messages
1
Hi
I have written a code which is working but it takes almost a minute to complete. Is it possible to optimize it?
I've working in Excel 2007.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
Dim wsmain As Worksheet
Dim pt As PivotTable, ptf As Variant
Dim pi As PivotItem
Dim strField As String
strField = "Month"
Dim strField2 As String


M1 = Worksheets(1).Range("f2:f2")
M2 = Worksheets(1).Range("f3:f3")
M3 = Worksheets(1).Range("f4:f4")
M4 = Worksheets(1).Range("f5:f5")
M5 = Worksheets(1).Range("f6:f6")
M6 = Worksheets(1).Range("f7:f7")
M7 = Worksheets(1).Range("f8:f8")
M8 = Worksheets(1).Range("f9:f9")
M9 = Worksheets(1).Range("f10:f10")
M10 = Worksheets(1).Range("f11:f11")
M11 = Worksheets(1).Range("f12:f12")
M12 = Worksheets(1).Range("f13:f13")

On Error Resume Next

If Target.Address = Range("D5:D5").Address Then
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
EnableMultiplePageItems = False
For Each ptf In pt.PivotFields
If ptf.Name = "Month" Then
With pt.PivotFields(strField)

For Each pi In .PivotItems
If pi = Target.Value Then
If pi.Value = Target.Value Then
.PivotItems("1").Visible = M1
.PivotItems("2").Visible = M2
.PivotItems("3").Visible = M3
.PivotItems("4").Visible = M4
.PivotItems("5").Visible = M5
.PivotItems("6").Visible = M6
.PivotItems("7").Visible = M7
.PivotItems("8").Visible = M8
.PivotItems("9").Visible = M9
.PivotItems("10").Visible = M10
.PivotItems("11").Visible = M11
.PivotItems("12").Visible = M12

.PivotItems("(Blank)").Visible = False
.PivotItems("-").Visible = False

Exit For

End If
Else

.PivotItems("1").Visible = False
.PivotItems("2").Visible = False
.PivotItems("3").Visible = False
.PivotItems("4").Visible = False
.PivotItems("5").Visible = False
.PivotItems("6").Visible = False
.PivotItems("7").Visible = False
.PivotItems("8").Visible = False
.PivotItems("9").Visible = False
.PivotItems("10").Visible = False
.PivotItems("11").Visible = False
.PivotItems("12").Visible = False

.PivotItems("(Blank)").Visible = False
.PivotItems("-").Visible = True


End If
Next pi

End With
End If
Next ptf

Next pt


Next ws
End If

End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,223,228
Messages
6,170,875
Members
452,363
Latest member
merico17

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
Back
Top