Filter only results in the next 28 days from Pivot Table using VBA

[dannybland]

Hi,

I am looking to filter my table to show only the data from the next 28 days, I tried using the below but it returned an error. Included full example below

pt.PivotFields("Dates").PivotFilters.Add Type:=xlDateBetween, Value1:=Today(), Value2:=Today() + 28



Sub PTFour()


Sheets.Add
ActiveSheet.Name = "x"

Dim pt As PivotTable
Dim strField As String
Dim WSD As Worksheet
Set WSD = Worksheets("Raw Data")
Dim PTOutput As Worksheet
Set PTOutput = Worksheets("x")
Dim PTCache As PivotCache
Dim PRange As Range

' Find the last row with data
Dim finalRow As Long
finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row

' Find the last column with data
Dim finalCol As Long
finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column

' Find the range of the data
Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)

' Create the pivot table
Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(1, 1), _
TableName:="EquityInvestmentPivot")

' Define the layout of the pivot table

' Set update to manual to avoid recomputation while laying out
pt.ManualUpdate = True

'Setting Fields
With pt

'set row field
With .PivotFields("Make/Model")
.Orientation = xlRowField
.Position = 1
End With


'set column field
With .PivotFields("Company Code")
.Orientation = xlColumnField
.Position = 1
End With


'set data field
.AddDataField .PivotFields("Remaining Equity Investment"), "Sum of Equity Invested", xlSum
End With

With ActiveSheet.PivotTables("EquityInvestmentPivot").PivotFields( _
"Sum of Equity Invested")
.NumberFormat = "£#,##0.00;[Red]-£#,##0.00"
End With

pt.PivotFields("Dates").PivotFilters.Add Type:=xlDateBetween, Value1:=Today(), Value2:=Today() + 28

' Now calc the pivot table
pt.ManualUpdate = False


ActiveSheet.PivotTables("EquityInvestmentPivot").TableStyle2 = _
"PivotStyleMedium4"
ActiveWorkbook.ShowPivotTableFieldList = False


MsgBox "Please see your requested pivot table. If you require another, please go back to the Pivot Table Selection tab."

End Sub

 

[dannybland]

I'm in 2007, does that make a difference?

 

[Andrew Poulsom]

Nope, it works fine for me in Excel 2007. Do you get a runtime error at any stage?

 

[dannybland]

No error, it just returns all data in the PT - included the full code in case that helps?

Sub PTFour()

    Sheets.Add
    ActiveSheet.Name = "Expiring Equity"
    
    Dim pt As PivotTable
    Dim strField As String
    Dim WSD As Worksheet
    Set WSD = Worksheets("Raw Data")
    Dim PTOutput As Worksheet
    Set PTOutput = Worksheets("Expiring Equity")
    Dim PTCache As PivotCache
    Dim PRange As Range
 
    ' Find the last row with data
    Dim finalRow As Long
    finalRow = WSD.Cells(Application.Rows.Count, 1).End(xlUp).Row
     
    ' Find the last column with data
    Dim finalCol As Long
    finalCol = WSD.Cells(1, Application.Columns.Count).End(xlToLeft).Column
     
    ' Find the range of the data
    Set PRange = WSD.Cells(1, 1).Resize(finalRow, finalCol)
    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:=PRange)
 
    ' Create the pivot table
    Set pt = PTCache.CreatePivotTable(TableDestination:=PTOutput.Cells(1, 1), _
    TableName:="ExpiringEquityPivot")
     
    ' Define the layout of the pivot table
     
    ' Set update to manual to avoid recomputation while laying out
    pt.ManualUpdate = True
     
    'Setting Fields
    With pt
    
    'set row field
    With .PivotFields("Make/Model")
    .Orientation = xlRowField
    .Position = 1
    End With


    'set column field
    With .PivotFields("Company Code")
    .Orientation = xlColumnField
    .Position = 1
    End With


    'set data field
    .AddDataField .PivotFields("Remaining Equity Investment"), "Sum of Equity Invested", xlSum
    End With
     
    With ActiveSheet.PivotTables("ExpiringEquityPivot").PivotFields( _
        "Sum of Equity Invested")
        .NumberFormat = "£#,##0.00;[Red]-£#,##0.00"
    End With
     
    'put filter on to included only deals ending in the next 4 weeks
    'pt.PivotFields("Termination Date").PivotFilters.Add Type:=xlDateBetween, Value1:=Date, Value2:=Date + 28
             
    Dim Fmt As String
    Dim PI As PivotItem
    With ActiveSheet.PivotTables("ExpiringEquityPivot").PivotFields("Termination Date")
        .ClearAllFilters
        Fmt = .NumberFormat
        .NumberFormat = "dd/mm/yyyy"
        For Each PI In .PivotItems
            Debug.Print CDate(PI.Value)
            PI.Visible = (DateValue(PI.Value) >= Date And DateValue(PI.Value) <= Date + 28)
        Next PI
        .NumberFormat = Fmt
    End With
            
  ' Now calc the pivot table
    pt.ManualUpdate = False


    ActiveSheet.PivotTables("ExpiringEquityPivot").TableStyle2 = _
        "PivotStyleMedium4"
    ActiveWorkbook.ShowPivotTableFieldList = False


    MsgBox "Please see all currently equity investment due to expire in the next 28 days. If you require another, please go back to the Pivot Table Selection tab."


End Sub

 

[Andrew Poulsom]

That code doesn't add Termination Date as a Report Filter.

 

[dannybland]

How do I do that? Sorry - inexperienced with using macros in PTs

 

[Andrew Poulsom]

The macro recorder is your friend. This is what it gave me:

Sub Macro6()
'
' Macro6 Macro
'
'
    With ActiveSheet.PivotTables("ExpiringEquityPivot").PivotFields( _
        "Termination Date")
        .Orientation = xlPageField
        .Position = 1
    End With
End Sub

 

[dannybland]

Thanks! One last one on this sorry do you know the code for larger than an amount? Do I remove the LHS?

PI.Visible = (DateValue(PI.Value) >=

 

[Andrew Poulsom]

Greater than is just >.

 

[dannybland]

So the current one does is greater than or equal to today, and less than or equal to today + 28 days.

I also need is greater than today + 1096 days in a separate PT please

 

[Andrew Poulsom]

Yes.

What have you tried?