Help Modifying Existing Forum Code that Filters Pivot Tables

[Katterman]

Hello Everyone

I'm looking for some assistance in Modifying some existing code to filter a pivot table.
I've searched all over the board (and Google) and found many variations of code to do this
but have yet to tweak it to a point that works for me.

I'm using some code provided by Jerry Sullivan found HERE and it works on my pivot table except
for one thing. I'm using an Array to hold a number of dates and i need the code to select only the
dates in the array to be visible. The code as is will select the first and last dates in the array but will also
select ALL dates in between. It does not "ignore" and dates that are midding from the array between the first and last dates.

This is what i have and would like to tweak to use only the vales found in my Array.

Sub Pivot_Outage_Dates()


'http://www.mrexcel.com/forum/excel-questions/606328-change-pivot-page-filter-based-upon-two-cell-values-dates.html#post3007354


    Dim dtFrom As Date, dtTo As Date
    Dim pt As PivotTable
    Dim ERow1 As Date
     
    With Sheets("STATS")
    ERow1 = Columns("O").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Value
    End With
    
    With Sheets("NAT_Pivot")
        Set pt = .PivotTables("PivotTable6")
        dtFrom = Sheets("STATS").Range("O10")
        dtTo = ERow1
    End With
    
    Call Filter_PivotField_by_Date_Range( _
        pt.PivotFields("Date Created"), dtFrom, dtTo)
End Sub


Public Function Filter_PivotField_by_Date_Range(pvtField As PivotField, _
        dtFrom As Date, dtTo As Date)
        Dim bTemp As Boolean, i As Long
        Dim dtTemp As Date, sItem1 As String
    
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual


    With pvtField
        .Parent.ManualUpdate = True
        For i = 1 To .PivotItems.Count
            dtTemp = .PivotItems(i)
            bTemp = (dtTemp >= dtFrom) And _
                (dtTemp <= dtTo)
            If bTemp Then
                sItem1 = .PivotItems(i)
                Exit For
            End If
        Next i
'        If sItem1 = "" Then
'            MsgBox "No items are within the specified dates."
'            Exit Function
'        End If




        If .Orientation = xlPageField Then .EnableMultiplePageItems = True
        .PivotItems(sItem1).Visible = True
        For i = 1 To .PivotItems.Count
            dtTemp = .PivotItems(i)
            If .PivotItems(i).Visible <> _
                ((dtTemp >= dtFrom) And (dtTemp <= dtTo)) Then
                .PivotItems(i).Visible = Not .PivotItems(i).Visible
            End If
        Next i
    End With
    
    pvtField.Parent.ManualUpdate = False
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Function

This code:

    With Sheets("STATS")
    ERow1 = Columns("O").Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows, LookIn:=xlValues).Value
    End With

Would need to be replaced with my Array Code:

    With Worksheets("STATS")
    Arr1 = .Range("O10", .Range("O" & Rows.Count).End(xlUp)).Value
    End With

And as far as the Array goes, it comes from a Dynamic range that populates with dates in a range of either
7 fields (Weekly) or 31 Fields (Monthly). It populates the array based on the Non Empty fields in the range.

Well, Hopefully that made sense and someone can assist.
Like mentioned before, I've looked around a lot and tried many pieces of code
before reaching out for help

Thank you all for reading and to those who reply.

Scott

 

[Katterman]

Hello Jerry

We can Consider this Resolved now.
After my last post i started to dig even deeper since the code was working on Work PC and not home PC
despite save versions of Excel.

I ended up resetting my systems' Regional Settings and for some reason that foxed the errors in Excel.
Even though those settings "Looked" the same between machines, I guess something was off that affected
Excel.

So your previous post of Cleaned code is now working.

Sorry for the extra efforts but i guess this is a learning experience for both of us
albeit more Me than You

You have helped immensely and am Very appreciative of your Time and Efforts
and Thank You many times over If you were local, I'd buy you a drink

Thanks Again
Scott

Hello Jerry

Ok, Some weird stuff now.

I Created a New WB from the 2 sheets required for you to test with.
I Ran the code and "ALL" works fine now. No Errors and Blanks NOT selected.
So, went back to my Original sheet and it works there as well.
This is on my Work PC that I VPN into.

The Strange part is, i have the same Excel at home I Where i sometimes work from
and that is where the exact copy of the sheet is failing with the error described above,
Recopied working sheet from Work PC to Home PC and still errors on Home Machine with
what works on Work PC.

Now i'm really Stumped but as far as this Work Data and Code is concerned, this seems to be OK.

I'll send you a PM with the link to my Test Data sheet that works on Work PC and Not at home with Same versions of Excel.

Since the code works where needed, i'd understand if you wan to consider this resolved.

Scott

 

[Jerry Sullivan]

Hi Scott, I'm happy to hear that you figured that out. Regional date settings other than "English-US" can cause a lot of additional challenges.

One item of note from reviewing the example workbook you sent...the PivotTable Options were set to allow the storing of items deleted from the Data Source.
To change that:

PivotTable Options... > Data tab > Number of items to retain per field: > set to "None".

Your example was set to the default "Automatic".

I forgot to get back to your early question about resources for learning VBA. Bill Jelen (MrExcel) and Tracy Syrstad have recently released "Excel 2016 VBA and Macros", which is very good for beginner and intermediate VBA users.

If I find myself in Burnaby BC, Canada, I'll certainly take you up on your offer!

 

[Katterman]

Hello Jerry

Thanks Again for all your help and Sorry it dragged out a bit longer that it should have
due to those settings. I've again adjusted the Pivot Options, Which i thought i did but maybe
reverted back when created the Sample sheet.

I will look into those reference you provided.

Again, Thanks So Much.
Until Next Time.....


Scott

Hi Scott, I'm happy to hear that you figured that out. Regional date settings other than "English-US" can cause a lot of additional challenges.

One item of note from reviewing the example workbook you sent...the PivotTable Options were set to allow the storing of items deleted from the Data Source.
To change that:

PivotTable Options... > Data tab > Number of items to retain per field: > set to "None".

Your example was set to the default "Automatic".

I forgot to get back to your early question about resources for learning VBA. Bill Jelen (MrExcel) and Tracy Syrstad have recently released "Excel 2016 VBA and Macros", which is very good for beginner and intermediate VBA users.

If I find myself in Burnaby BC, Canada, I'll certainly take you up on your offer!