The code below adds pivot fields to my pivot table upon selection from a listbox. It currently runs okay, but it gets slower and slower as more items are selected from the listbox. Is there a way to speed up the code below? I believe there is an issue with the looping that is taking it longer when more items are selected. Any help would be great!
Private Sub ListBox2_Change()
'PxV DATES
Application.ScreenUpdating = False
Dim i As Long
With ListBox2
For i = 0 To .ListCount - 1
On Error Resume Next
If .Selected(0) Then
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("PxV 12"), Sheets("SCodes").Range("V3").Value, xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V3").Value)
.NumberFormat = "$#,##0.00"
End With
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V3").Value).Orientation = xlHidden
End If
'Next Date
If .Selected(1) Then
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("PxV 11"), Sheets("SCodes").Range("V4").Value, xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V4").Value)
.NumberFormat = "$#,##0.00"
End With
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V4").Value).Orientation = xlHidden
End If
'Next Date
If .Selected(2) Then
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("PxV 10"), Sheets("SCodes").Range("V5").Value, xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V5").Value)
.NumberFormat = "$#,##0.00"
End With
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V5").Value).Orientation = xlHidden
End If
'Next Date
If .Selected(3) Then
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables("PivotTable1").PivotFields("PxV 9"), Sheets("SCodes").Range("V6").Value, xlSum
With ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V6").Value)
.NumberFormat = "$#,##0.00"
End With
Else
ActiveSheet.PivotTables("PivotTable1").PivotFields(Sheets("SCodes").Range("V6").Value).Orientation = xlHidden
End If
Next i
End With
End Sub
Bookmarks