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