Pivot Code Error

[Rudi]

Hi,

I am getting an error on the following code: Application or Object Defined Error.
I just cannot seem to get it working??? Any ideas what the issue is?

The pivot table on the worksheet is surrounded by other data so I need to have it filter only for a three month period. I cannot clear the filters else it will overwrite data on the right due to 12 months. Even after recording a macro to filter, then run the recorded code, it bombs out with the same error?

Code: Select all

Dim myD1 As String, myD2 As String, MthCount As Integer
    myD1 = Range("MAPSSD").Value
    myD2 = Range("MAPSED").Value
    MthCount = 12
    Sheets("MAPS Report").PivotTables("AppCount").PivotFields("Date").PivotFilters.Add _
        Type:=xlDateBetween, Value1:=myD1, Value2:=myD2

TX

[Rudi]

OK...I have located the error source:
If I delete the tables to the right (so that there is room for the filter to clear and show all 12 months) then the code works. So it seems the filter MUST be cleared before a new filter can be applied. This is nasty!!! I looked to see if there is a method called EDIT, but there is not! Only an ADD method exists for PivotFilters.

Is there any clever suggestions/advice to get around this issue....TIA

[HansV]

You can't add a filter if a filter has already been applied. You MUST clear the existing filter first. Perhaps you could insert a large number of cells (or columns) to the right of the pivot table, clear the filter and apply the new one, then delete the inserted cells.

[Rudi]

LOL ... as simple as that!!! Works!
TX

Code: Select all

Dim myD1 As String, myD2 As String, MthCount As Integer
    myD1 = Range("MAPSSD").Value
    myD2 = Range("MAPSED").Value
    MthCount = 12
    Sheets("MAPS Report").Range("K:V").Insert
    Sheets("MAPS Report").PivotTables("AppCount").PivotFields("Date").ClearAllFilters
    Sheets("MAPS Report").PivotTables("AppCount").PivotFields("Date").PivotFilters.Add _
        Type:=xlDateBetween, Value1:=myD1, Value2:=myD2
    Sheets("MAPS Report").Range("K:V").Delete

I need that smiley : Stupid me!! (That one with the hammer and the blood from WOPR) - Where did that smiley go to.

[HansV]

I'd add

Application.ScreenUpdating = False

before the code, and

Application.ScreenUpdating = True

after it.

[Rudi]

Thats already there in the larger macro: but thanks for the heads up! :)

Code: Select all

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    Sheets("MAPS Report").Range("A1").Select
    ActiveWorkbook.RefreshAll
Dim myD1 As String, myD2 As String, MthCount As Integer
    myD1 = Range("MAPSSD").Value
    myD2 = Range("MAPSED").Value
    MthCount = 12
    Sheets("MAPS Report").Range("K:V").Insert
    Sheets("MAPS Report").PivotTables("AppCount").PivotFields("Date").ClearAllFilters
    Sheets("MAPS Report").PivotTables("AppCount").PivotFields("Date").PivotFilters.Add _
        Type:=xlDateBetween, Value1:=myD1, Value2:=myD2
    Sheets("MAPS Report").Range("K:V").Delete
    Sheets("MAPS Report").PivotTables("PerfCount").PivotFields("Date").ClearAllFilters
    Sheets("MAPS Report").PivotTables("PerfCount").PivotFields("Date").PivotFilters.Add _
        Type:=xlDateBetween, Value1:=myD1, Value2:=myD2
    Range("E:E,K:K,P:P").ColumnWidth = 4
    Sheets("MAPS Report").Range("A1").Select
    Application.ScreenUpdating = True
End Sub