excelguy
excelguy

Reputation: 1624

VBA, Changing PivotField 'Filter' based on Input value

Previously I have asked the question on how to change the Pivotfield 'Row' (VBA, Application-defined or Object Error, changing Pivot Filter). However it seems like changing the 'Filter' field is different.

Here is my code I use to change the pivottable 'row' value with vba, Period being the 'filter' field in my pivot. When I run it I get an error msg Could not apply filter which is user error handling.

Dim pivTable1 As PivotTable

    
    Set pivTable1 = GetPivotTable(ThisWorkbook, "Summary of LoBs", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    periodField.ClearAllFilters
    

    

    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Input").Range("H2").Value2
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Missing Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try String first
    If VarType(filterDate) = vbString Then
        periodField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=filterDate
        If Err.Number = 0 Then Exit Sub
        
        filterDate = CDbl(CDate(filterDate))
        Err.Clear
    End If
    
    If VarType(filterDate) <> vbDouble Then
        MsgBox "Invalid Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    'Try Date (as Double data type)
    periodField.PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Could not apply filter", vbInformation, "Cancelled"
        Exit Sub
    End If

any help would be appreciated. Thanks.

Upvotes: 0

Views: 270

Answers (2)

Dy.Lee
Dy.Lee

Reputation: 7567

The filter part of the pivot looks like a date format, but your original data is a character that looks like a date.

Although the original data format is a pure date data format, the pivot filter is expressed as text. However, if the original data is a character, xlCaptionEquals should be used, and if the original data is a date format, xlSpecificDate should be used.

However, all values of value1 must be in String format. Therefore, you need to accurately grasp the format of your original data, and it is recognized as text data in pictures.

Upvotes: 1

Cristian Buse
Cristian Buse

Reputation: 4558

I've added a select case that solves both cases (row or field):

Sub ApplyFilter()
    Dim pivTable1 As PivotTable

    Set pivTable1 = GetPivotTable(ThisWorkbook, "Summary of LoBs", "PivotTable1")
    If pivTable1 Is Nothing Then
        MsgBox "Missing Pivot Table", vbInformation, "Cancelled"
        Exit Sub
    End If
    pivTable1.PivotCache.Refresh
    
    Dim periodField As PivotField
    
    On Error Resume Next
    Set periodField = pivTable1.PivotFields("Period")
    On Error GoTo 0
    If periodField Is Nothing Then
        MsgBox "Missing Pivot Field", vbInformation, "Cancelled"
        Exit Sub
    End If
    periodField.ClearAllFilters
    
    Dim filterDate As Variant
    
    On Error Resume Next
    filterDate = ThisWorkbook.Worksheets("Input").Range("H2").Value2
    If Err.Number <> 0 Then
        Err.Clear
        MsgBox "Missing Filter Date", vbInformation, "Cancelled"
        Exit Sub
    End If
    
    Select Case periodField.Orientation
    Case xlRowField
        'Try String first
        If VarType(filterDate) = vbString Then
            periodField.PivotFilters.Add Type:=xlCaptionEquals, Value1:=filterDate
            If Err.Number = 0 Then Exit Sub
            
            filterDate = CDbl(CDate(filterDate))
            Err.Clear
        End If
        
        If VarType(filterDate) <> vbDouble Then
            MsgBox "Invalid Filter Date", vbInformation, "Cancelled"
            Exit Sub
        End If
        
        'Try Date (as Double data type)
        periodField.PivotFilters.Add Type:=xlSpecificDate, Value1:=filterDate
        If Err.Number <> 0 Then
            Err.Clear
            MsgBox "Could not apply filter", vbInformation, "Cancelled"
            Exit Sub
        End If
    Case xlPageField
        Dim pivItem As PivotItem
        Dim v As Variant
        
        For Each pivItem In periodField.PivotItems
            v = pivItem.Value
            If VarType(v) = VarType(filterDate) Then
                pivItem.Visible = (v = filterDate)
            Else
                'Try converting to date
                If IsDate(v) And IsDate(filterDate) Then
                    pivItem.Visible = (CDate(v) = CDate(filterDate))
                Else
                    'Add other logic based on your needs
                    Err.Raise 5, , "Need more code here"
                End If
            End If
        Next pivItem
    Case Else
        MsgBox "Could not apply filter!" & vbNewLine & "Field must be a <Row> or <Filter> field!", vbInformation, "Cancelled"
    End Select
End Sub

However, you will see a comment 'Add other logic based on your needs". You will need to add logic based on the data types if the code here doesn't solve the problem.

Upvotes: 1

Related Questions