Streamline VBA code

[Biz]

Hi Guys,

Can anyone help me streamline this code further?
The code looks at report filter in Pivot and makes a list of items included and excluded.

Sub Information()
'Including
Dim aItem As PivotItem
    With Range("C1")
     .Value = "Including"
     .Font.Bold = True
     .Offset(1, 0).ClearContents
    End With
    
    For Each aItem In ActiveSheet.PivotTables("PivotTable1").PivotFields("Spirits").PivotItems
        If aItem.Visible = True Then
            Range("C2") = Range("C2") & aItem & ","
        End If
    Next
    
    If Range("C2").Value <> "" Then
        Range("C2") = Left(Range("C2"), Len(Range("C2")) - 1) ' Remove unnecessary commas
    End If

'Excluding
    With Range("D1")
     .Value = "Excluding"
     .Font.Bold = True
     .Offset(1, 0).ClearContents
    End With
    
    For Each aItem In ActiveSheet.PivotTables("PivotTable1").PivotFields("Spirits").PivotItems
        If aItem.Visible = False Then
            Range("D2") = Range("D2") & aItem & ","
        End If
    Next
    
    If Range("D2").Value <> "" Then
        Range("D2") = Left(Range("D2"), Len(Range("D2")) - 1) ' Remove unnecessary commas
    End If
End Sub

Biz

 

[Myproblem]

if you are looking to get only certain fields to be visible other not you can find something usefull here: http://www.mrexcel.com/forum/showthread.php?t=572376

 

[AlphaFrog]

<font face=Courier New><SPAN style="color:#00007F">Sub</SPAN> Information()<br><br>    <SPAN style="color:#00007F">Dim</SPAN> aItem  <SPAN style="color:#00007F">As</SPAN> PivotItem<br><br>    <SPAN style="color:#00007F">With</SPAN> Range("C1:D1")<br>        .Value = Array("Including", "Excluding")<br>        .Font.Bold = <SPAN style="color:#00007F">True</SPAN><br>        .Offset(1).ClearContents<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><br>    <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> aItem <SPAN style="color:#00007F">In</SPAN> ActiveSheet.PivotTables("PivotTable1").PivotFields("Spirits").PivotItems<br>        <SPAN style="color:#00007F">If</SPAN> aItem.Visible <SPAN style="color:#00007F">Then</SPAN><br>            <SPAN style="color:#007F00">'Including</SPAN><br>            Range("C2") = Range("C2") & "," & aItem<br>        <SPAN style="color:#00007F">Else</SPAN><br>            <SPAN style="color:#007F00">'Excluding</SPAN><br>            Range("D2") = Range("D2") & "," & aItem<br>        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>    <SPAN style="color:#00007F">Next</SPAN> aItem<br><br>    Range("C2") = Mid(Range("C2"), 2)    <SPAN style="color:#007F00">' Remove leading comma</SPAN><br>    Range("D2") = Mid(Range("D2"), 2)    <SPAN style="color:#007F00">' Remove leading comma</SPAN><br>    <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

 

[Biz]

Sub Information()

Dim aItem As PivotItem

With Range("C1:D1")
.Value = Array("Including", "Excluding")
.Font.Bold = True
.Offset(1).ClearContents
End With

For Each aItem In ActiveSheet.PivotTables("PivotTable1").PivotFields("Spirits").PivotItems
If aItem.Visible Then
'Including
Range("C2") = Range("C2") & "," & aItem
Else
'Excluding
Range("D2") = Range("D2") & "," & aItem
End If
Next aItem

Range("C2") = Mid(Range("C2"), 2) ' Remove leading comma
Range("D2") = Mid(Range("D2"), 2) ' Remove leading comma

End Sub

Hi AlphaFrog,

Thanks for picking up my error. It seems strange this method works in Excel 2010 but fails if I save file as xls and close it and run again.

Do you know what code I need to use so that if file is saved as Excel 2003 then it also works?

Link to file is below
http://www.megaupload.com/?d=9C1SFWEPhttp://www.megaupload.com/?d=9C1SFWEP

Biz

 

[AlphaFrog]

I use Excel 2003 and the code works for me.

I don't have Excel 2010 to test with. I know there are a few new Pivot table features in 2010 that are not backwards compatible, but I don't know specifics.

Try doing it the other way around. Create the Pivot Table and file in Excel 2003. Then save as Excel 2010 format (.xlsx)

 

[Biz]

Thanks I will try it. Unfortuantely I don't have xl 2003 at work but have it home.

Biz