Excel VBA - Privot table filter multiple uncertain criteria

2
votes

I have 2 tables, one contains list of projects, the other one is a pivot table with details of those projects. What I need to do is take several prject numbers that fom a group from one table, filter the Pivot table based on that number, copy he presented data and then move to next Project number from the first table.
I use parts of the code from Excel VBA - Privot table filter multiple criteria by Shai Rado

For k = 1 To  10
conv = Cells(k, 24)
arr(k) = conv
Next
Set PVT = ActiveSheet.PivotTables("PivotTable1")

For Each PivotItem In PVT.PivotFields("Project ID").PivotItems
    If Not IsError(Application.Match(PivotItem.Caption, arr, 0)) Then ' check if current item is not in the filter array
        PivotItem.Visible = True
    Else
        PivotItem.Visible = False
    End If
Next PivotItem

The problem I have is when there is no Project Id present in the pivot table.

For example I have project Id 118 and 156, they get assigned to the arr, but the Pivot table does not hold those values I get an error.

One solution would beto run a comparison script to check if the pivot table has that value before running the filter, but using vlook up or another FOR command for that takes too long. Is there any easier solution to just skip the filter if the value is not found? Or trigger a different command?

1
vbaexcel

1 Answers

0
votes

Before we start:

1 way to make your PivotTable update faster is to set PVT.ManualUpdate = True before you start messing with the PivotItems, then set it to PVT.ManualUpdate = False and run PVT.Update after they are all set.

This will stop Excel trying to rebuild the PivotTable every time you change an item, and instead do 1 big update at the end.

So, on to the actual issue!

Have you tried just adding a checksum? Start with a Long set to 0, then add 1 to it every time you set PivotItem.Visible = True. If it is 0, then there are no items to show. If it is not 0, then you know how many matches there were. As a rough guide, you're looking for something like this:

For k = 1 To 10
    conv = Cells(k, 24)
    arr(k) = conv
Next
Set PVT = ActiveSheet.PivotTables("PivotTable1")
Dim lCounter As Long
lCounter = 0

PVT.ManualUpdate = True

For Each PivotItem In PVT.PivotFields("Project ID").PivotItems
    If Not IsError(Application.Match(PivotItem.Caption, arr, 0)) Then ' check if current item is not in the filter array
        PivotItem.Visible = True
        lCounter = lCounter + 1
    Else
        PivotItem.Visible = False
    End If
Next PivotItem

If lCounter < 1 Then
    PVT.PivotFields("Project ID").ClearAllFilters 'Show EVERYTHING
    MsgBox "None of the specified Projects were found.", vbCritical, ":("
End If

PVT.Update
PVT.ManualUpdate = False