VBA to filter between dates in Pivot Table

KDavidP1987

Board Regular
Joined
Mar 6, 2018
Messages
51
Greetings,

I'm trying to filter between two dates in Excel Pivot Tables using VBA. I need the script to recognize the start date as a date entered by the user in a named cell, and the end date as current date. I've tried several scripts for accomplishing this, but all have failed thus far (various error messages). I don't know if it's simply a problem in the syntax I've attempted, or something else all-together. I just feel like this should be possible.
:confused:

Code:
[INDENT=2]Sub AdjustPivots2()[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]' AdjustPivots2 Macro[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]Dim SDate As String[/INDENT]
[INDENT=2]Dim EDate As String[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]Dim pt As PivotTable[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]'Dim pvtF As PivotField[/INDENT]
[INDENT=2]'Dim pvtI As PivotItem[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]SDate = Format([RStartDate], "Short Date")[/INDENT]
[INDENT=2]EDate = Format(Date, "Short Date")[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]    Sheets("Pivot_Incidents-Closed").Select[/INDENT]
[INDENT=2]    ActiveSheet.PivotTables("PivotTable5").ClearAllFilters[/INDENT]
[INDENT=2]    [/INDENT]
[INDENT=2]    Sheets("Pivot_Aging Report").Select[/INDENT]
[INDENT=2]    ActiveSheet.PivotTables("PivotTable6").ClearAllFilters[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]    Sheets("Pivot_Incidents-Closed").Select[/INDENT]
[INDENT=2]    ActiveSheet.PivotTables("PivotTable5").PivotFields("Date Closed").CurrentPage _[/INDENT]
[INDENT=2]        = "(no data)"[/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]'------ Attempted Method # 1 --------[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]'Set pvtF = Worksheets("Pivot_Incidents-Closed").PivotTables("PivotTable5").PivotFields("Date Closed")[/INDENT]
[INDENT=2]'For Each pvtI In pvtF.PivotItems[/INDENT]
[INDENT=2]'    If DateValue(pvtI.Name) >= SDate <= EDate Then[/INDENT]
[INDENT=2]'        pvtI.Visible = True[/INDENT]
[INDENT=2]'    Else[/INDENT]
[INDENT=2]'        pvtI.Visible = False[/INDENT]
[INDENT=2]'    End If[/INDENT]
[INDENT=2]'Next pvtI[/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]'------ Attempted Method # 2 --------[/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]'    With ActiveSheet.PivotTables("PivotTable5").PivotFields("Date Closed").PivotFilters[/INDENT]
[INDENT=2]'    .Add Type:=xlDateBetween, Value1:=SDate, Value2:=EDate[/INDENT]
[INDENT=2]'    End With[/INDENT]
[INDENT=2]        [/INDENT]
[INDENT=2]'------ Attempted Method # 3 --------[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]'Amend here to filter your data[/INDENT]
[INDENT=2]Set pt = Worksheets("Pivot_Incidents-Closed").PivotTables("PivotTable5")[/INDENT]
[INDENT=2]    pt.PivotFields("Date Closed").ClearAllFilters[/INDENT]
[INDENT=2]    'This line is needed to clear existing filter before applying new one[/INDENT]
[INDENT=2]   pt.PivotFields("Date Closed").PivotFilters.Add Type:=xlDateBetween, _[/INDENT]
[INDENT=2]        Value1:=CLng((Range("[RStartDate]").Value)), Value2:=CLng((Now))[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]'------ Attempted Method # 4 --------[/INDENT]
[INDENT=2]'    Do While SDate <= Date[/INDENT]
[INDENT=2]'    On Error GoTo Invalid[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]'            With ActiveSheet.PivotTables("PivotTable5").PivotFields("Date Closed")[/INDENT]
[INDENT=2]'                .PivotItems(SDate).Visible = True[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]'            End With[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]'Invalid:[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]'        SDate = SDate + 1[/INDENT]
[INDENT=2]'[/INDENT]
[INDENT=2]'    Loop[/INDENT]
[INDENT=2]    [/INDENT]
[INDENT=2]
[/INDENT]
[INDENT=2]End Sub[/INDENT]

Apologies for any mess in the code, I've attempted it several ways after scouring online resources. :( Any help would be greatly appreciated!

Sincerely,
Kristopher Penland
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
use this code. make a form w 2 textboxes: txtStartDate, txtEndDate.
paste this code in the form.
you enter start,end dates on the form and when it runs,
it scans the dates, then posts a flag on the records that fit in the range


then you can run a pivot table on the results


be sure to set your column settings in:
Const kFLAGfldLtr = "D" 'column for the flag field
Const kDATEfld = "A" 'date field to check


make a button to run btnFind_Click()


Code:
Private Sub btnFind_Click()
Dim vStart As Date, vEnd As Date, vDat As Date
Dim iFlagCol As Long, r As Long, iDatCol As Long
Const kFLAGfldLtr = "D"     'column for the flag field
Const kDATEfld = "A"


If Not IsValidForm() Then Exit Sub


iFlagCol = Range(kFLAGfldLtr & "1").Column
iDatCol = Range(kDATEfld & "1").Column


Range("A2").Select
r = ActiveSheet.UsedRange.Rows.Count


  'clear the field flags
Columns(kFLAGfldLtr & ":" & kFLAGfldLtr).Clear
Range(kFLAGfldLtr & "1").Value = "Found"
vStart = txtStartDate
vEnd = txtEndDate
    
    'flag matching records
Range("A2").Select
While ActiveCell.Value <> ""
   vDat = ActiveCell.Offset(0, iDatCol - 1).Value
   If vStart <= vDat And vDat <= vEnd Then
       ActiveCell.Offset(0, iFlagCol - 1).Value = True
   End If
   
   ActiveCell.Offset(1, 0).Select  'next row
Wend


Range(kFLAGfldLtr & "1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$" & kFLAGfldLtr & "$" & r).AutoFilter Field:=iFlagCol, Criteria1:="<>"


Unload Me
End Sub
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,027
Messages
6,175,990
Members
452,693
Latest member
Dethpod1

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