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

dannybland

New Member
Joined
Sep 12, 2014
Messages
31
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
 

Excel Facts

Get help while writing formula
Click the italics "fx" icon to the left of the formula bar to open the Functions Arguments dialog. Help is displayed for each argument.
What does the macro recorder give you if you filter the field manually? Note that the VBA equivalent of Today is Date.
 
Upvote 0
Using record doesn't give the formulas for today or how to add 28 to today's date.

pt.PivotFields("Termination Date").PivotFilters.Add Type:=xlDateBetween, Value1:=Date(), Value2:=Date() + 28
 
Upvote 0
With ActiveSheet.PivotTables("PivotTable2").PivotFields("Termination Date")
.PivotItems("8/24/2014").Visible = False
.PivotItems("8/27/2014").Visible = False
.PivotItems("8/28/2014").Visible = False
.PivotItems("9/1/2014").Visible = False
.PivotItems("9/2/2014").Visible = False
.PivotItems("9/3/2014").Visible = False
.PivotItems("9/4/2014").Visible = False
.PivotItems("9/5/2014").Visible = False
.PivotItems("9/6/2014").Visible = False
.PivotItems("9/7/2014").Visible = False
.PivotItems("9/8/2014").Visible = False
.PivotItems("9/9/2014").Visible = False
.PivotItems("9/10/2014").Visible = False
.PivotItems("9/11/2014").Visible = False
.PivotItems("9/12/2014").Visible = False
.PivotItems("9/13/2014").Visible = False
.PivotItems("9/14/2014").Visible = False
.PivotItems("10/3/2014").Visible = False
.PivotItems("10/4/2014").Visible = False
.PivotItems("10/5/2014").Visible = False
.PivotItems("10/6/2014").Visible = False
.PivotItems("10/7/2014").Visible = False
.PivotItems("10/8/2014").Visible = False
.PivotItems("10/9/2014").Visible = False
.PivotItems("10/10/2014").Visible = False
.PivotItems("10/11/2014").Visible = False
.PivotItems("10/12/2014").Visible = False
.PivotItems("10/13/2014").Visible = False
.PivotItems("10/14/2014").Visible = False
.PivotItems("10/15/2014").Visible = False
.PivotItems("10/16/2014").Visible = False
.PivotItems("10/17/2014").Visible = False
.PivotItems("10/18/2014").Visible = False
.PivotItems("10/19/2014").Visible = False
.PivotItems("10/20/2014").Visible = False
.PivotItems("10/21/2014").Visible = False
End With
 
Upvote 0
That's not a Value Filter, and you can only apply one to a Data field. In what area of the pivot table is the field "Termination Date"?
 
Upvote 0
Its in the Report Filter box, I'm not too interested in the actual dates, just need to be able to report on any that terminate in the next week, and also any that don't terminate for more than 3 years.
For example

Termination Date(All)
Sum of Equity InvestedCompany Code
Make/ModelCBFCBLCOSGrand Total
ALFA ROMEO£0.00£0.00
ALFA ROMEO MITO£5,502.25£5,502.25
AUDI A1£2,269.44£34,706.50£871,789.38£908,765.32
AUDI A3£239,785.24£0.00£5,286,494.87£5,526,280.11
AUDI A4£182,311.77£25,363.05£400,156.48£607,831.30
AUDI A4 ALLROAD£183,076.39£183,076.39

<colgroup><col><col span="3"><col></colgroup><tbody>
</tbody>
 
Upvote 0
it shows -

Report Filter - Termination Date
Column Labels - Company Code
Row Labels - Make/Model
Values - Sum of Equity Invested
 
Upvote 0
Assuming you are in the UK, try:

Code:
Sub Test()
    Dim Fmt As String
    Dim PI As PivotItem
    With ActiveSheet.PivotTables("PivotTable2").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
End Sub
 
Upvote 0
It doesn't seem to be filtering out any information? I tried amending the >= to <= but that didn't work either.

Code:
PI.Visible = (DateValue(PI.Value) <= Date And DateValue(PI.Value) <= Date + 28)
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top