VBA Guru's - any way to speed up this code?

[Job]

Here is one of the subs I'm using to update pivot tables from a form that
has a multselect list box. It seems to run very slow, so I'm wondering if
someone would do it differently.

Sub multiselection()
'''''''''*********************************
''get all the values from the multiselect list and use to filter what is
seen

Set Pivot1 = Worksheets("Compensation by
Specialty").PivotTables("PivotTable6")
cou = ListBox1.ListCount - 1
Dim l(1 To 128)
n = 1
For y = 0 To cou

' If the item is selected...
If ListBox1.Selected(y) = True Then

l(n) = ListBox1.List(y)
n = n + 1

End If
Next y
If l(1) = "(All)" Then
For Each x In Pivot1.PivotFields("Specialty " _
).PivotItems

x.Visible = True
Next x
' With ActiveSheet.PivotTables("PivotTable6").PivotFields("Specialty ")
' .PivotItems("X").Visible = False
' End With
Pivot1.PivotFields("Specialty ").CurrentPage = _
"(All)"

ElseIf n - 1 = 1 And l(1) <> "X" Then
For Each x In Pivot1.PivotFields("Specialty " _
).PivotItems

x.Visible = True
Next x
Pivot1.PivotFields("Specialty ").CurrentPage = _
l(1)

ElseIf l(1) <> "(All)" Then
For Each x In Pivot1.PivotFields("Specialty " _
).PivotItems
On Error Resume Next
If x.Value = "" Then
x.Visible = False
ElseIf x.Value = "(blank)" Then
ElseIf x.Value <> "(blank)" Then
x.Visible = False
End If
Next x


With Pivot1.PivotFields("Specialty " _
)
For pvt = 1 To n - 1

.PivotItems(l(pvt)).Visible = True
Next pvt


End With
If n - 1 > 1 Then
With Pivot1.PivotFields("Specialty ")
.PivotItems("X").Visible = False
End With
Pivot1.PivotFields("Specialty ").CurrentPage = _
"(All)"
End If
''''''''''******************************
End If
End Sub

Cheers!

Job

 

[keepITcool]

Try following example in a simple userform, with 1 listbox.
adapt to suit correct pivot and field.

Synchonization of dropdown and listbox done in 1 loop.
Screenupdating set to false, eliminating fklicker and improving speed.


Option Explicit

Dim i&, pf As PivotField

Private Sub ListBox1_Change()
On Error GoTo errH:
Application.ScreenUpdating = False
With Me.ListBox1
For i = 0 To .ListCount - 1
pf.PivotItems(.List(i)).Visible = .Selected(i)
Next
endH:
Application.ScreenUpdating = True
Exit Sub
errH:
'Error thrown when no item visible, reselect
.Selected(i) = True
GoTo endH
End With
End Sub

Private Sub UserForm_Activate()
Dim pi As PivotItem
Set pf = ActiveSheet.PivotTables(1).PivotFields("datum")
For Each pi In pf.PivotItems
Me.ListBox1.AddItem pi.Value
Next
'select first item, will trigger LB's changeevent,
'thus sync listbox and dropdown
Me.ListBox1.Selected(0) = True
End Sub





--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Job wrote :