简体   繁体   中英

Use VBA to Set Pivot Table to Specific Date Based on Another Field

I have tried many iterations that I have found on the web but cannot get this to work. I have a pivot table that I need to update weekly and I need the date to be set to a variable base on a field in the worksheet. The date is a filter. Using the code below, I can change the date to a specific date.

Sub Macro7()

'
 ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).CurrentPageName = "[Test_Data].[Date].&[2020-07-12T00:00:00]"
End Sub

However, when I try to set the date to a variable such as a string that points to the worksheet cell containing the date, it errors out, normally stating 'Unable to set the CurrentPage property of the PivotField class'. I have tried many different options and different code but nothing has worked. D2 is where the date is that changes. It updates based on a formula. I have tried also just hard coding the dates in the cell but that does not work either. Have also tried matching up date formats to the pivot, did not help. The field pulls the date of the last Friday, if that matters. I would be fine putting that into the code instead, if that would help (I tried, I got an error that the string could not be converted to the date).

Sub My_macro()
    Dim str As String
    str = ActiveSheet.Range("d2")
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
        ).ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]").CurrentPage = str
End Sub

Can someone please tell me how to correct this? Have been trying for hours and hours and just cannot get it figured. Thanks. PS--I tried to upload a sheet, but I cannot figure out how, looks like I can only do pictures, so I uploaded that. Below is the pivot where the date filter is the issue, and below that is a sample of what feeds the pivot.
样本

数据源示例

Edit: Have shared a sample of the file here: https://www.dropbox.com/sh/4tzrrue0mggf6om/AAAd6024feSdc9MbCd9IZD0Wa?dl=0

When you record a macro you will get something like this

Sub Macro1()
'
' Macro1 Macro
'

'
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
        ClearAllFilters
    ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
        CurrentPage = "[_Data].[Date].&[2019-08-16T00:00:00]"
End Sub

Even though the macro gave you that code, it will error out if you directly ran it without changing anything.

Solution : This is a very old problem which can be fixed by changing CurrentPage to CurrentPageName

Now changing it to suit your need...

Sub Sample()
    Dim ws As Worksheet
    Set ws = Sheet1
    
    Dim rngDt As Range
    Set rngDt = ws.Range("D2")
    
    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")
    
    Dim pt As PivotTable
    Set pt = ws.PivotTables("PivotTable2")
    
    Dim pf As PivotField
    Set pf = pt.PivotFields("[_Data].[Date].[Date]")
    
    pf.ClearAllFilters
    pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
End Sub

EDIT

May I ask you...how can I select MULTIPLE pivots on the same sheet and do this to their filters as well, picking the same date (cell D2) for all of them? Just repeat the code down, subbing in the names, or would something like an array work? Thank you again, marking yours as the answer! – learningthisstuff 2 days ago

You can do that in loop. For each pt in ws.PivotTables and then For each pf in pt.PivotFields:) – Siddharth Rout 2 days ago

Thanks....where do I put those lines? I tried a couple of places I thought made sense but keep getting errors. I will keep trying options, wondering if I need to remove the 'set pt/pf' lines? Thank you. – learningthisstuff 14 hours ago >

Do they have the same field "Date"? – Siddharth Rout 13 hours ago

Yes, they are all almost identical. Same filters. – learningthisstuff 11 hours ago

You can try something like this ( Untested )

Sub Sample()
    Dim ws As Worksheet
    Set ws = Sheet1
    
    Dim rngDt As Range
    Set rngDt = ws.Range("D2")
    
    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")
    
    Dim pt As PivotTable
    Dim pf As PivotField
    
    For Each pt In ws.PivotTables
        Set pf = pt.PivotFields("[_Data].[Date].[Date]")
        pf.ClearAllFilters
        pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
    Next pt
End Sub

EDIT

As requested by OP's edit to this answer, since there are multiple pivots, the following changes to the above code was finally made.

Sub Sample2()
    Dim ws As Worksheet
    Set ws = Worksheets("Sheet1")

    Dim rngDt As Range
    Set rngDt = ws.Range("F32")

    Dim dtString As String
    dtString = Format(rngDt.Value2, "yyyy-mm-dd")

    Dim pt As PivotTable
    Dim pf As PivotField

    For Each pt In ws.PivotTables
        If pt = "PivotTable2" Then
            Set pf = pt.PivotFields("[_Data].[Date].[Date]")
            pf.ClearAllFilters
            pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
        Else
            Set pf = pt.PivotFields("[Sales_Data].[Date].[Date]")
            pf.ClearAllFilters
            pf.CurrentPageName = "[Sales_Data].[Date].&[" & dtString & "T00:00:00]"
        End If
    Next pt
End Sub

EDIT: Never worked with cubefields, but this seems to do what you want:

Sub My_macro()
    
    Dim dt As Date, pt As PivotTable, pf As PivotField
    
    dt = ActiveSheet.Range("d2")
    Set pt = ActiveSheet.PivotTables(1)
    
    Set pf = pt.PageFields("[_Data].[Date].[Date]")
    With pf
        .ClearAllFilters
        .CubeField.EnableMultiplePageItems = True
        .VisibleItemsList = _
             Array("[_Data].[Date].&[" & Format(dt, "yyyy-mm-dd") & "T00:00:00]")
    End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM