VBA Pivot Table Filter Run-time error '1004': Application-defined or object-defined error

0
votes

I am trying to write a VBA script to update a pivot table's filters based on the value in two cells but I keep getting a 1004 run-time error. I have tried various approaches based on answers to other questions but I still can't figure out what the problem is.

Note: I have read that the error sometimes occurs because pivot tables require at least one visible value, but this error occurs even if I set Visible = True

VBA Code:

Private Sub PageItemFilter()
Dim pvtF As PivotField
Dim pvtI As PivotItem
Dim startDate As Date
Dim endDate As Date
Dim filterDate As Date

startDate = Range("start_date").Value
endDate = Range("end_date").Value

Set pvtF = Worksheets("selection").PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]")
pvtF.ClearAllFilters
For Each pvtI In pvtF.PivotItems
    filterDate = DateValue(Mid(pvtI.Name, 24, 10))
    If filterDate >= startDate And filterDate <= endDate Then
        Debug.Print (pvtI.Name)
        Debug.Print (TypeName(pvtI))
        Debug.Print (pvtI.Visible)
        pvtI.Visible = True
    Else
        pvtI.Visible = False
    End If
Next pvtI

End Sub

Output (first item):

[tbl_Main].[TransactionDate].&[2019-08-05T00:00:00]
PivotItem
True

Error: Run-time error '1004': Application-defined or object-defined error

2
excelvba
I don't understand why I can read the variable pvtI.Visible but I can't set it. If there is another approach to this problem, even if it isn't a VBA solution, I'd be happy to try it - E P
Why not skip setting the visible property if it's already visible (and you just cleared all filters, so all items will be visible before you enter the loop)? - Tim Williams
@TimWilliams I can but it still throws an error on pvtI.Visible = False. I've picked up that the code only loops through the items that are already visible (if I don't clear all filters) and I wonder if that isn't a clue to what the problem is? - E P
Sorry I'm out of ideas and can't really test without a pivot table. Maybe take a look here: stackoverflow.com/questions/49453039/… - Tim Williams
@TimWilliams Thank you so much!! It looks like that is the answer. I'll try it out and then post my findings. Thanks for your help! - E P

2 Answers

0
votes

try add condition to check does pivot item is visible like

 ..... code
 if not pvtI.Visible = True then pvtI.Visible = True 
 Else
     if not pvtI.Visible = false then pvtI.Visible = false 
 End If
 Next pvtI
 End Sub
0
votes

Thank you to @TimWilliams for directing me to this solution. The short answer is that what I was trying to do is not possible with OLAP PivotTables. I implemented a version of the suggested solution and it works like a charm! I have included my solution code below for anyone stumbling upon this question.

Sub PageItemFilter()
Dim pvtF As PivotField
Dim pvtI As PivotItem
Dim startDate As Date
Dim endDate As Date
Dim filterDate As Date
Dim visibleArray() As String
Dim isEmpty As Boolean

ReDim visibleArray(1 To 1) As String

startDate = Range("start_date").Value
endDate = Range("end_date").Value
isEmpty = True

Worksheets("selection").Activate
Set pvtF = Worksheets("selection").PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]")
pvtF.ClearAllFilters

If startDate > endDate Then
    MsgBox "The start date is after the end date. Cannot update filters"
    Exit Sub
End If

For Each pvtI In pvtF.PivotItems
    filterDate = DateValue(Mid(pvtI.Name, 35, 10))
    If filterDate >= startDate And filterDate <= endDate Then
        isEmpty = False
        visibleArray(UBound(visibleArray)) = pvtI.Name
        If filterDate >= endDate Then
            Exit For
        Else
            ReDim Preserve visibleArray(1 To UBound(visibleArray) + 1) As String
        End If
    End If
Next pvtI

If isEmpty Then
    MsgBox "No data for the dates selected. Cannot update filters"
    Exit Sub
Else
    ActiveSheet.PivotTables("PivotTable1").PivotFields("[tbl_Main].[TransactionDate].[TransactionDate]").VisibleItemsList = visibleArray
End If

End Sub