Filter Pivot Table Data by Range of Dates

[JAlbers]

Greetings All,

I have a Dashboard report that is generated by a macro. I was having the macro refresh the pivot data, then read each record and copy the ones that were between 0-180 days old. These copied records then served as the data for the dashboard reports and graphs.

The problem was twofold. First, the time it took to refresh the pivot table, and Second reading each record tended to get stalled and the macro would freeze up and not exit though the error trap.

Being new to VBA and for that matter to Pivot Tables, I don't see a way to tell the pivot table I only want records that are no more than 180 days old from right now without going in and ticking off check marks in the filter.

Does anyone have any suggestions? I'm stumped.

Thanks

Jacob
Excel 2003 & 2010

 

[Jerry Sullivan]

Jacob, We should be able to replace most of that with a PivotFilter step then a single copy step.

Please provide a few details:
1. The PivotTable's Name:
2. The Name of the PivotField that has the Dates of interest:
3. Your current code is copying columns A:P for selected rows. Is this the entire PivotTable, or are there more columns after column P that you are choosing not to copy?

 

[Jerry Sullivan]

Here's some code you could try after editing the Pivot Name and Field Name to match your's.

Sub OnMySix_2()
    Dim dtBreak As Date
    dtBreak = Date - 180
    
    Application.ScreenUpdating = False
    Application.ThisWorkbook.RefreshAll
    
    Sheets("Data Staging").Cells.Clear
    With Sheets("Pivot Table").PivotTables("[COLOR="Blue"]PivotTable1[/COLOR]")
        .PivotCache.Refresh
        With .PivotFields("[COLOR="blue"]Dates[/COLOR]")
            .ClearAllFilters
            .PivotFilters.Add Type:=xlDateBetween, _
                Value1:=dtBreak, Value2:=Date
        End With
        .TableRange1.Copy
    End With
    With Sheets("Data Staging").Range("A5")
        .PasteSpecial (xlPasteFormats)
        .PasteSpecial (xlPasteValues)
    End With
    
    Application.ScreenUpdating = True
End Sub