Howdy folks. Jeff here, with a money-saving Christmas tip. Oh, and some PivotTable code.
I recently posted a routine to filter pivots based on an external range. My code worked out whether it was fastest to either:
- Hide all items in the field, then unhide those Pivot Items that matched the search terms; or
- Unhide all items in the field, then hide those Pivot Items that don’t match the search terms.
It worked out what to hide or leave by adding the Search Terms to a Dictionary, then trying to add the Pivot Items and catching any errors. In that first case where it unhides Pivot Items that match the search terms, here’s the code that did the dictionary check on the PivotItems – after the Search Terms had already been added:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 |
With dic For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If Err.Number <> 0 Then 'This item exists in our search term list, so we should unhide it 'Note that IF this item is a date but the PivotField format is NOT a date format, ' we can't programatically hide/show items, so we'll have to check this first If Not bDateFormat Then If Not IsNumeric(pi.Value) Then 'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates If IsDate(pi.Value) Then If Not bDateWarning Then On Error GoTo ErrHandler Err.Raise Number:=997, Description:="Can't filter dates" On Error Resume Next End If Else: pi.Visible = True End If Else: pi.Visible = True End If Else: pi.Visible = True End If End If Err.Clear Next End With <a href="http://dailydoseofexcel.com/archives/2013/11/05/excel-isnt-fully-cooked/#comment-96559">Pete</a> commented <em>Another user might want to filter to exclude records listed in an external range</em>. Damn users. Bane of my life. Ah well...I thought I'd have a crack at rewriting the routine to do such exclusions. I was really surprised by how easy it was. For implementing an inverse filter, I added an optional bInverse argument to the function, with a default value of False. In the case that the function is called with that argument being TRUE, I need the revised code to dynamically change this line: If Err.Number <> 0 Then ...to this: If Err.Number = 0 Then Using an <strong>If</strong> or <strong>Select Case</strong> construct is one way you could do this: With dic For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If bInverse Then If Err.Number <> 0 Then 'This item exists in our search term list, so we should unhide it 'Note that IF this item is a date but the PivotField format is NOT a date format, ' we can't programatically hide/show items, so we'll have to check this first If Not bDateFormat Then If Not IsNumeric(pi.Value) Then 'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates If IsDate(pi.Value) Then If Not bDateWarning Then On Error GoTo ErrHandler Err.Raise Number:=997, Description:="Can't filter dates" On Error Resume Next End If Else: pi.Visible = True End If Else: pi.Visible = True End If Else: pi.Visible = True End If End If Else: If Err.Number = 0 Then 'This item exists in our search term list, so we should unhide it 'Note that IF this item is a date but the PivotField format is NOT a date format, ' we can't programatically hide/show items, so we'll have to check this first If Not bDateFormat Then If Not IsNumeric(pi.Value) Then 'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates If IsDate(pi.Value) Then If Not bDateWarning Then On Error GoTo ErrHandler Err.Raise Number:=997, Description:="Can't filter dates" On Error Resume Next End If Else: pi.Visible = True End If Else: pi.Visible = True End If Else: pi.Visible = True End If End If End If Err.Clear Next End With |
…but that seems like overkill, because the only line we want to conditionally change is that If Err.Number <> 0 Then line. The rest of the block is just fine the way it is.
So how to conditionally change just that one line? Like this:
|
1 |
If Err.Number <> 0 = Not bInverse Then |
Boy, that was simple. Adding the 2nd logical effectively flips the If Err.Number <> 0 bit to If Err.Number = 0 in the case that bInverse is TRUE.
It works a treat: I tested it on a Pivot containing the things I’m willing to buy the kids for Christmas, and an external list of things containing the presents that the kids actually want. Suffice to say I set bInverse to TRUE, and saved myself a small fortune in a few milliseconds.
And there’s your Christmas tip. Ho ho horrible, I know.
Here’s the whole amended routine:
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 |
Option Explicit Sub FilterPivot() ' Description: Wrapper function for my FilterPivot Function ' (Required in the event that a user wants to trigger the FilterPivot ' function and specify parameters at runtime, instead of programatiacally ' calling the routine) ' Programmer: Jeff Weir ' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz ' Name/Version: Date: Ini: Modification: ' FilterPivot 20150305 JSW Initial programming FilterPivot_Routine End Sub Sub FilterPivot_Invert() ' Description: Wrapper function for my FilterPivot_Inverse Function ' Inverts the current selection ' (Required in the event that a user wants to trigger the FilterPivot_Inverse ' function and specify parameters at runtime, instead of programatiacally ' calling the routine) ' Programmer: Jeff Weir ' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz ' Name/Version: Date: Ini: Modification: ' FilterPivot_Inverse 20150305 JSW Initial programming FilterPivot_Routine ActiveCell.PivotField.DataRange, ActiveCell.PivotField.DataRange, bInverse:=True End Sub Sub FilterPivot_Inverse() ' Description: Wrapper function for my FilterPivot_Inverse Function ' (Required in the event that a user wants to trigger the FilterPivot_Inverse ' function and specify parameters at runtime, instead of programatiacally ' calling the routine) ' Programmer: Jeff Weir ' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz ' Name/Version: Date: Ini: Modification: ' FilterPivot_Inverse 20150305 JSW Initial programming FilterPivot_Routine bInverse:=True End Sub Private Sub FilterPivot_AddRightClick() ' Description: Adds "Filter Pivotfield" shortcuts to PivotTable right-click menu ' Programmer: Jeff Weir ' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz ' Name/Version: Date: Ini: Modification: ' AddShortcuts 20150305 JSW Initial programming Dim cbr As CommandBar Dim sMessage As String Set cbr = Application.CommandBars("PivotTable Context Menu") With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True) .Caption = "Filter Pivotfield" .Tag = "FilterPivotField" .OnAction = "FilterPivot" .Style = msoButtonIconAndCaption .Picture = Application.CommandBars.GetImageMso("FilterAdvancedByForm", 16, 16) End With With cbr.Controls.Add(Type:=msoControlButton, Temporary:=True) .Caption = "Inversely Filter Pivotfield" .Tag = "FilterPivotField" .OnAction = "FilterPivot_Inverse" .Style = msoButtonIconAndCaption .Picture = Application.CommandBars.GetImageMso("FilterAdvancedMenu", 16, 16) End With sMessage = "Cool, I've added an option for you to trigger this code by right-clicking " sMessage = sMessage & "the PivotTable field that you want to filter." sMessage = sMessage & vbNewLine & vbNewLine & "Happy filtering!" MsgBox sMessage, vbOKOnly, "Right-click options added..." End Sub Private Sub FilterPivot_RemoveRightClick() ' Description: Removes "Filter Pivotfield" shortcuts from PivotTable right-click menu ' Programmer: Jeff Weir ' Contact: weir.jeff@gmail.com or jeff.weir@HeavyDutyDecisions.co.nz ' Name/Version: Date: Ini: Modification: ' AddShortcuts 20150305 JSW Initial programming Dim cbr As CommandBar Dim sMessage As String Dim ctrl As CommandBarControl Set cbr = Application.CommandBars("PivotTable Context Menu") For Each ctrl In cbr.Controls If ctrl.Tag = "FilterPivotField" Then ctrl.Delete Next sMessage = "Cool, I've removed the RightClick options for the FilterPivot routines." MsgBox sMessage, vbOKOnly, "Right-click options added..." End Sub Private Function FilterPivot_Slicers(ptTemp As PivotTable, pfTemp As PivotField, ptOriginal As PivotTable) Dim sc As SlicerCache ' This sub-function contains code that requires Slicers ' It's in this stand-alone function, becaues it only gets called if user has Excel 2010 or later ' If it was incorporated DIRECTY within the FilterPivot function, that function wouldn't compile on pre 2010 machines Set sc = ActiveWorkbook.SlicerCaches.Add(ptTemp, pfTemp) sc.PivotTables.AddPivotTable ptOriginal 'Great, our original pivot now just has one item visible in the field of interest 'So we can delete the slicer connection sc.Delete End Function Private Function FilterPivot_Routine(Optional rngPivotField As Range, Optional rngFilterItems As Range, Optional bInverse As Boolean = False) As Boolean ' Copyright ©2013 Jeff Weir ' weir.jeff@gmail.com ' You are free to use this code within your own applications, add-ins, ' documents etc but you are expressly forbidden from selling or ' otherwise distributing this source code without prior consent. ' This includes both posting free demo projects made from this ' code as well as reproducing the code in text or html format. ' --------------------------------------------------------------------- ' Date Initial Version Details ' 20131113 JSW 007 Initial Programming ' 20131203 JSW 008 Added Inverse Option ' 20140503 JSW 009 Changed so works in pre Excel 2010 ' 20140503 JSW 010 Changed so pi.format check not performed in Excel 2013 + ' 20150223 JSW 011 Added check to ensure pfOriginal has .EnableMultiplePageItems set to TRUE if it is a pagefield. ' 20150429 JSW 012 Turned off events, cleared pfOriginal filter. '############# '# Remarks # '############# ' This code needs to be called by a wrapper function. ' e.g. ' Sub FilterPivot() ' FilterPivot_Routine ' End Sub ' Sub FilterPivot_Inverse() ' FilterPivot_Routine bInverse:=True ' End Sub ' If required, that wrapper function can also provide ranges ' specifying what PivotField to filter, and where the range of ' filter terms is. e.g.: ' FilterPivot_Routine Range("A2"), Range("C2:C20000") ' ...or ' FilterPivot_Routine ActiveCell, [tblFilterItems] Dim ptOriginal As PivotTable Dim ptTemp As PivotTable Dim pfOriginal As PivotField Dim pfTemp As PivotField Dim pfFilterItems As PivotField Dim lngFilterItems As Long Dim pi As PivotItem Dim ptFilterItems As PivotTable Dim wksTemp As Worksheet Dim wksPivot As Worksheet Dim dic As Object Dim varContinue As Variant Dim strMessage As String Dim varFormat As Variant Dim bDateFormat As Boolean Dim bDateWarning As Boolean Dim bFirstItemVisible As Boolean Dim varFirstItemVisible As Variant FilterPivot_Routine = False 'Assume failure On Error GoTo errhandler Set wksPivot = ActiveSheet 'If neccessary, prompt user for the pivotfield of interest If rngPivotField Is Nothing Then On Error Resume Next Set rngPivotField = ActiveCell Set pfOriginal = rngPivotField.PivotField 'Tests if this is in fact a PivotField If Err <> 0 Then Err.Clear Set rngPivotField = Nothing Set rngPivotField = Application.InputBox( _ Title:="Where is the PivotField?", _ Prompt:="Please select a cell in the PivotField you want to filter", _ Type:=8) On Error GoTo errhandler If rngPivotField Is Nothing Then Err.Raise 996 End If On Error GoTo errhandler End If Set pfOriginal = rngPivotField.PivotField Set ptOriginal = pfOriginal.Parent With pfOriginal If .Orientation = xlPageField Then If .EnableMultiplePageItems = False Then .EnableMultiplePageItems = True .ClearAllFilters End If End If End With 'If neccessary, prompt user for FilterItems table related to the pivotfield of interest If rngFilterItems Is Nothing Then On Error Resume Next Set rngFilterItems = Application.InputBox( _ Title:="Where are the filter items?", _ Prompt:="Please select the range where your filter terms are.", _ Type:=8) On Error GoTo errhandler If rngFilterItems Is Nothing Then Err.Raise 996 End If With Application .ScreenUpdating = False .Calculation = xlCalculationManual .EnableEvents = False End With ' Excel stores dates differently between PivotItems and Variant Arrays. ' For instance: ' ? CStr(varFilterItems(i, 1)) ' 1/01/2013 ' ? pi.Value ' 1/1/2013 ' ? CStr(varFilterItems(i, 1)) = pi.Value ' False 'So we 'll turn our FilterItems into a PivotTable to ensure formats are treated the same. Set wksTemp = Sheets.Add rngFilterItems.Copy wksTemp.Range("A2") wksTemp.Range("A1").Value = "FilterItems" Set rngFilterItems = wksTemp.Range("A2").CurrentRegion On Error GoTo errhandler ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _ rngFilterItems).CreatePivotTable _ TableDestination:=[C1], TableName:="appFilterItems" Set ptFilterItems = wksTemp.PivotTables("appFilterItems") Set pfFilterItems = ptFilterItems.PivotFields(1) ' Add FILTERItems to a Dictionary Set dic = CreateObject("scripting.dictionary") For Each pi In pfFilterItems.PivotItems dic.Add pi.Value, 1 'The one does nothing Next ptOriginal.ManualUpdate = True 'dramatically speeds up the routine, because the pivot won't recalculate until we're done 'Check if PFOriginal is formatted as a date field. ' Basically there is a bug in Excel whereby if you try to do some things ' to a PivotItem containing a date but the PivotField number format is NOT a date format ' then you get an error. ' So we'll check the PivotField date format and see what it is ' Note that if a PivotField is based on a range that contains multiple formats ' then you get an error simply by checking what the PivotField number format is. ' So we'll instigate an On Error Resume Next to handle this On Error Resume Next varFormat = pfOriginal.NumberFormat On Error GoTo errhandler If IsDate(Format(1, varFormat)) Then bDateFormat = True If bInverse Then lngFilterItems = pfOriginal.PivotItems.Count - rngFilterItems.Count Else: lngFilterItems = rngFilterItems.Count End If If lngFilterItems / pfOriginal.PivotItems.Count < 0.5 And Application.Version >= 14 Then '==================================================================================== ' If it's likely that less than half of the source Pivot Field's ' items will be visible when we're done, then it will be quickest to hide all but one ' item and then unhide the PivotItems that match the filter terms ' Iterating through a large pivot setting all but one item to hidden is slow. ' And there's no way to directly do this except in Page Fields, and ' that method doesn't let you select multiple items anyway. ' Plus, as soon as you drag a page field with just one item showing to ' a row field, Excel clears the filter, so that all items are visible again. ' So we'll use a trick: ' * make the pf of interest in ptTemp a page field ' * turn off multiple items and select just one PivotItem ' * connect it to the original pivot with a slicer ' This will very quickly sync up the field on the original pivot so that only one field is showing. ' NOTE: WE CAN ONLY DO THIS IF USING EXCEL 2010 OR LATER using the below approach. ' If earlier version, we'll use the approach outlined in the ELSE part of this IF block. ' ALSO NOTE: If a PivotField has a non-Date format, but contains dates, then ' we can't programatically hide/show items. So we need to check for this. '==================================================================================== 'Identify a suitable item with which to filter the original PivotTable with ' As per note above, ' * If the PivotField format is NOT a date format, ' then we need to make sure that this first item is NOT a date. ' ...because otherwise we can't address it by VBA ' * If the PivotFied format IS a date format, then just use the first item. ' * We'll write that item to a range, then to a variant, so that Excel applies the ' same format to it as it does to items in our Filter list If Not bDateFormat Then For Each pi In pfOriginal.PivotItems If IsDate(pi.Value) Then If IsNumeric(pi.Value) Then 'We need the IsNumeric bit above because 'VBA thinks that some decimals encased in strings e.g. "1.1" are dates 'So we need to check whether this is a decimal and NOT a date varFirstItemVisible = pi.Value Exit For Else: If Not bDateWarning Then Err.Raise Number:=997, Description:="Can't filter dates" End If End If Else: varFirstItemVisible = pi.Value Exit For End If Next Else: varFirstItemVisible = pfOriginal.PivotItems(1).Value End If Set ptTemp = ptOriginal.PivotCache.CreatePivotTable(TableDestination:=wksTemp.Range("F1")) Set pfTemp = ptTemp.PivotFields(pfOriginal.SourceName) With pfTemp .Orientation = xlPageField .ClearAllFilters .EnableMultiplePageItems = False .CurrentPage = pfTemp.PivotItems(varFirstItemVisible).Value End With Call FilterPivot_Slicers(ptTemp, pfTemp, ptOriginal) ' Check if FirstItemVisible should be visible or hidden when we are done If dic.Exists(varFirstItemVisible) Then bFirstItemVisible = True ' Now try and add the PivotItems. ' If there's an error, we'll know that this item is also in the FilterTerms On Error Resume Next With dic 'The Not bInverse bit in the code blocks below effectively 'flip' the test "If Err.Number <> 0" to "If Err.Number = 0" 'in the case that bInverse argument is TRUE (meaning we want the Pivot to be filtered on things ' NOT in the list of search terms) If Application.Version >= 15 Then For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If Err.Number <> 0 = Not bInverse Then pi.Visible = True End If Err.Clear Next Else: 'There's a bug in previous versions where you can't use .Visible for dates 'if the PivotField is set to General format. For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If Err.Number <> 0 = Not bInverse Then ' This item exists in our search term list, so we should unhide it ' Note that due to a bug in Excel 2010, if this item is a date ' but the PivotField format is NOT a date format, we can't ' programatically hide/show items, so we'll have to check this first If Not bDateFormat Then If Not IsNumeric(pi.Value) Then 'We need the Not IsNumeric bit above because VBA thinks that ' some decimals encased in strings e.g."1.1" are dates If IsDate(pi.Value) Then If Not bDateWarning Then On Error GoTo errhandler Err.Raise Number:=997, Description:="Can't filter dates" On Error Resume Next End If Else: pi.Visible = True End If Else: pi.Visible = True End If Else: pi.Visible = True End If End If Err.Clear Next End If 'If Application.Version >= 15 Then End With If Not bFirstItemVisible = Not bInverse Then pfOriginal.PivotItems(varFirstItemVisible).Visible = False If Err.Number <> 0 Then MsgBox "None of the filter items were found in the Pivot" pfOriginal.ClearAllFilters Err.Clear End If End If Else: ' If it's likely that MORE than half of the source Pivot Field's items will be visible ' when we're done, then it's quickest to unhide all PivotItems and then hide the ' PivotItems that DON'T match the filter terms pfOriginal.ClearAllFilters ' Now try and add the PivotItems. ' If there's an error, we'll know that this item is in the FilterItems ' Otherwise we'll hide it On Error Resume Next With dic If Application.Version >= 15 Then For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If Err.Number = 0 = Not bInverse Then pi.Visible = False Err.Clear Next Else: For Each pi In pfOriginal.PivotItems dic.Add pi.Value, 1 'The 1 does nothing If Err.Number = 0 = Not bInverse Then 'The Not bInverse bit effectively 'flips' the test "If Err.Number = 0" to "If Err.Number <> 0" 'in the case that bInverse argument is TRUE (meaning we want the Pivot to be filtered on things ' NOT in the list of search terms) 'This PivotItem NOT in FilterItems list. So hide it 'Note that IF this item is a date but the PivotField format is NOT a date format, ' then we can't programatically hide/show items, so we'll have to check this first If Not bDateFormat Then If Not IsNumeric(pi.Value) Then 'We need the Not IsNumeric bit above because VBA thinks that some decimals encased in strings e.g."1.1" are dates If IsDate(pi.Value) Then If Not bDateWarning Then On Error GoTo errhandler Err.Raise Number:=997, Description:="Can't filter dates" On Error Resume Next End If Else: pi.Visible = False 'This item does not exist in the FilterItems. So hide it End If Else: pi.Visible = False 'This item does not exist in the FilterItems. So hide it End If Else: pi.Visible = False End If End If Err.Clear Next End If 'If Application.Version >= 15 Then End With End If 'If lngFilterItems / pfOriginal.PivotItems.Count < 0.5 And Application.Version >= 14 Then On Error GoTo errhandler FilterPivot_Routine = True errhandler: If Err.Number <> 0 Then Select Case Err.Number Case Is = 0: 'No error - do nothing Case Is = 996: 'Operation Cancelled Case Is = 997: 'Can't filter dates strMessage = "*** WARNING...I can't correctly filter dates in this Pivot ***" strMessage = strMessage & vbNewLine & vbNewLine strMessage = strMessage & "I've found at least one date in this PivotField. " strMessage = strMessage & "Unfortunately due to a bug in Excel, if you have dates " strMessage = strMessage & " in a PivotField AND that PivotField is NOT formatted " strMessage = strMessage & " with a date format, then dates " strMessage = strMessage & " can't be programatically filtered either in or out. " strMessage = strMessage & vbNewLine & vbNewLine strMessage = strMessage & " So you'll have to manually check to see whether " strMessage = strMessage & " date items appear as they should." strMessage = strMessage & vbNewLine & vbNewLine strMessage = strMessage & "Do you want me to continue anyway? " varContinue = MsgBox(Prompt:=strMessage, Buttons:=vbYesNo, Title:="Sorry, can't filter dates") If varContinue = 6 Then bDateWarning = True Resume Next Else: pfOriginal.ClearAllFilters End If Case Is = 998: 'Can't filter Datafields MsgBox "Oops, you can't filter a DataField." & vbNewLine & vbNewLine & "Please select a RowField, ColumnField, or PageField and try again.", vbCritical, "Can't filter Datafields" Case Is = 999: 'no pivotfield selected MsgBox "Oops, you haven't selected a pivotfield." & vbNewLine & vbNewLine & "Please select a RowField, ColumnField, or PageField and try again.", vbCritical, "No PivotField selected" Case Else: MsgBox "Whoops, something went wrong" End Select End If With Application If Not wksTemp Is Nothing Then .DisplayAlerts = False wksTemp.Delete .DisplayAlerts = True End If .ScreenUpdating = True .Calculation = xlCalculationAutomatic .EnableEvents = True End With If Not ptOriginal Is Nothing Then ptOriginal.ManualUpdate = False End Function |
That is the longest code listing I have ever seen!
Yep. But I think you’ll find that where filtering pivots robustly is concerned, it’s also the fastest code you’ve ever seen.
Jeff…of that I have no doubt!
@All: Code updated. Also added a routine to let you trigger via right-click context menu.
Jeff,
Thanks so much for making this! There’s a lot of study I want to do this one. I added this code to my Personal workbook, then I hope you don’t mind but I made some alterations: I took off the “Private” from the Right-Click subs so I could call them from other places, and commented out the MsgBox in the “FilterPivot_AddRightClick” macro because it’s going to be fired quite often. I added “FilterPivot_AddRightClick” to my Personal’s “Workbook_Open” macro, so the menu is available for any pivot workbook I open. In my Custom tab I added a link to the “FilterPivot_RemoveRightClick” in case I ever see a reason to remove that option from my menu, but right now I can’t imagine why I would.
Thank You!
Glad it’s of use, Jomili
I have 4 Cascading ActiveX Combo Box’s and I want to change my Pivot Table on a separate page in order to change my pivot Chart on the page where my combo boxes are. So basically i want to filter my table via selections made by each of my combo boxes. How can I adapt this?
Eric: I’d be keen to look a little closer at what you want to do. Can you flick a sample file to weir.jeff@gmail.com so I can take a look?
Eric: Here’s an easy non-VBA way that gets around the need for comboboxes: Use Slicers, with the ‘Hide items with no data’ option in the Slicer Settings dialog checked for each of them. When that setting is checked, only relevant items appear in all of the slicers, which is exactly what you’re trying to achieve with these combo boxes.
Note that while it is possible to achieve what you want via VBA, because of MS’s crap object model where slicers are concerned it requires you to iterate over the Slicers.Items collection and set the .visible status for each of the items…which can be slow on large PivotTables e.g. 20k items might take you 4 minutes.
That said, I do have a devious but horribly convoluted method that I’m working on that will let you deselect all but one SlicerItems immediately so that you can then directly unhide the ones you want. But it is pretty wild code that noone will be able to get their head around in a hurry should it error out.
So if your PivotTable has lots of data in it, seriously consider using Slicers instead of a Combo Box for any user interaction with it.
I haven’t run this in a while, but I’m now getting an error on the “FilterPivot_Slicers” function. It’s on the very first line, “Set sc=Activeworkbook.SlicerCaches.Add(ptTemp, pfTemp). Not sure what the problem is, because the error message is the “Whoops”. Help would be appreciated.
I suspect the problem is that there is already a SlicerCache for that PivotCache/Pivotfield combo in the workbook. Can you tell me what happens when you mouse over ptTemp and pfTemp variables, or add a watch for them and send me a screenshot? Or even email your file to me at weir.jeff@gmail.com.
I’m in the process of recoding this routine to make it faster still, and to also let it filter OLAP Pivots, by the way.
Could this be adjusted so that the fields selected in say pivotA (in this case by slicer) are connected to pivotB but what shows of pivotB is the inverse of pivotA?
I had made a comment re inverse filtering the pivot. I just found the right click solution within your code. Brilliant. thank you so much. Extremely useful.
Glad you found it helpful, leroy.
Hi Jeff,
I am not the VBA programmer. I have issue in OLAP based Pivot table. Lets say i have 1000 items in report. but user wants some 50 items not in the report. this can be on any other field also. how i can exclude the user list item from the Pivot table.
Tejas Shah