Pivottable, remove obsolete items

Tommy Bak · Dec 29, 2003

Hi
does anyone know how to get rid of obsolete / missing items. ?
If the database is updated and the pivottable is refreshed, the dropdownboxes still contains items that has been removed from the database.
Is it possible to update these items

Regards
Tommy Bak

Tommy Bak · Dec 30, 2003

This is what I ended up with.
It takes into account that some items may be calculated items, which will have a count of 0
Thank to all who helped me on this one.
If anyone have knowledge of a smarter way, please inform me

Code:

Sub CleanPivotItem()
Dim PT As PivotTable
Dim PF As PivotField
Dim PI As PivotItem

For Each PT In ActiveSheet.PivotTables
    For Each PF In PT.PivotFields
        For Each PI In PF.PivotItems
            If PI.RecordCount = 0 And PI.IsCalculated = False Then PI.Delete
        Next PI
    Next PF
Next PT

End Sub

regards
Tommy Bak

dk · Dec 30, 2003

Hi,

Seems like you have sorted your problem Tommy but I thought I'd throw in my two pennies worth:-

1. Drag the field in question off of the pivot table.
2. Refresh the pivot table.
3. Drag the field back to its previous location. The deleted items should have disappeared from the drop-down.

This is still a labourious way of fixing this but is probably easier than re-creating the pivot table from scratch.

Tommy Bak · Dec 31, 2003

Hi Dan
That what I would do normally (when I used xl97), but it doesn't seem to work in XP
Thank you anyhow

regards
Tommy Bak

Greg Truby · Dec 31, 2003

I really wish I would have scrolled to Page 2 of this sooner! I basically recreated what Tommy did on my own...

However, I also ran into some errors, so here's what I ended up with:



Sub CleanPivotItems()

 Dim pt As PivotTable, pf As PivotField, pi As PivotItem
 Dim booShowMsg As Boolean, mbxResult As VbMsgBoxResult

 booShowMsg = True
 On Error GoTo ErrorHandler

 For Each pt In ActiveSheet.PivotTables
 For Each pf In pt.PivotFields
 For Each pi In pf.PivotItems
 If pi.RecordCount = 0 And pi.IsCalculated = False Then
 Debug.Print "Trying to delete - "; pi.Name; " "; pi.RecordCount; " Parent = "; pf.Name
 pi.Delete
 End If
 Next pi
 Next pf
 Next pt
 Set pi = Nothing
 Set pf = Nothing
 Set pt = Nothing
 Exit Sub

ErrorHandler:

 If booShowMsg Then
 mbxResult = MsgBox("Macro could not delete item." & vbCr & _
 "Likely cause is that at one time this item was part of a group." & _
 vbCr & vbCr & "Click [CANCEL] to supress further Error messages.", _
 vbExclamation + vbOKCancel, "Error Deleting PivotItem")
 booShowMsg = (mbxResult = vbOK)
 End If
 Resume Next
End Sub


Fun problem Tommy. (100% credit to Tommy for the IsCalculated check - I totally missed that!)

Tommy Bak · Jan 1, 2004

Greg -> I like your errorhandler.
I also found that the macro stopped at strange places, in some pivots. Especially where there were empty() in the dropdownbox.
I will adopt this macro...

regards Tommy

Greg Truby · Jan 5, 2004

Tommy,

Someone posted the exact same question on 12/31. I xref'd this post but Mike (aka Ekim) xref'd a different URL that had some very helpful ideas.

Based on info from that post - I did the following - which handled my grouping trouble-makers without erroring. You might try it on your troublemakers and see if it stands up to them. I don't know how this responds to calculated fields (I've yet to need them).

'¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯
Sub CleanPivotItems2()
'______________________________________________________________________________

' ***********************
' ***** XL2002 ONLY *****
' ***********************

' Even after a Refresh, a PT retains options for checking / unchecking
' that are no longer part of the source data set. This macro goes
' through all pivot tables on the active sheet and cleans off
' any PivotItems that no longer have corresponding records in the source
' data block.

' Note: This only needs to be run once. After .MissingItemsLimit has
' been set to xlMissingItemsNone, a simple REFRESH will remove dead
' checkbox items.

 Dim pt As PivotTable

 For Each pt In ActiveSheet.PivotTables
 pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
 pt.PivotCache.Refresh
 Next pt

 Set pt = Nothing

End Sub


Regards,

Tommy Bak · Jan 5, 2004

Greg
Thankyou for the link and the code.
Seem that we were on the right track in xl2000

regards
Tommy

akhil8377 · Jan 14, 2004

Hi All

This can be done in following way without deleting Pivot tables.

1. Go back to query again and give another alias name for the field

2. Say for example the field name which you have origianlly is Year in the query. Now change this in query and give a new alias name as Yr,

3.When you return back to Pivot table, now field Yr will hold only latest items and will not show obsolete items.

4. Field Yr can again be changed back to Year in Pivot table by editing it.

priy1234 · May 18, 2012

Greg Truby said:
I've got to get home, but this appears to work if I go in by hand and uncheck the Show All box and then check one box for a record that I know still exists...

Sub DeletePivotItemTest()
****Dim pi1 As PivotItem
****On Error Resume Next
****For Each pi1 In ActiveSheet.PivotTables("PivotTable2").PivotFields("Rep").PivotItems
********If pi1.Visible = False Then pi1.Delete
****Next pi1
End Sub

I was so much stuck.. This helped me a lot thanks

Pivottable, remove obsolete items

Tommy Bak

Active Member

Tommy Bak

Active Member

Excel Facts

dk

MrExcel MVP

Tommy Bak

Active Member

Greg Truby

MrExcel MVP

Tommy Bak

Active Member

Greg Truby

MrExcel MVP

Tommy Bak

Active Member

akhil8377

Board Regular

priy1234

New Member

Similar threads

Forum statistics

Share this page

Pivottable, remove obsolete items

Active Member

Active Member

Excel Facts

MrExcel MVP

Active Member

MrExcel MVP

Active Member

MrExcel MVP

Active Member

Board Regular

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock