Need Help In Applying Filter in Pivot Created through Macro

[allExcell]

Hi All,

I'm new to this forum, but not too new as a follower. I've started learning VBA for my own sake and tips and tricks that I've seen in your forum was actually too helpful.


This time I need a help. I've a work sheet containing base data and the other sheet with a Pivot created based on the Base data. Here, I've created one Macro which is generating the Pivot. Now the Problem is that there are few fileds which needs filters to be placed. As for example one Date Filter which will take the date from another sheet from the same workbook and will populate the Pivot as "after or equal to" the date provided, let's say in Sheet3, Cell B2. And, one more filter is needed at the 1st Field, which will select only 10 out of some 80 odd values, this I've tried creating an array and tried to call the Values in a List given in a seperate Sheet from the same workbook, unfortunately the code is throwing some error, which I'm sure because of my poor knowledge in VBA (but surely improving). The Code I've highlighted with Red/Bold is actually throwing the error which says, "Run Time Error '1004'. AutoFilter method of Range Class Failer".




The codes are given below for your ref:

 Sub MakePivotTable_Tab1_Ovrdue_Qual()
    Dim pt As PivotTable
    Dim strField As String
    Dim WSD As Worksheet
    Set WSD = Worksheets("Sheet1")
    Dim PTOutput As Worksheet
    Set PTOutput = Worksheets("Sheet2")
    Dim PTCache As PivotCache
    Dim PRange As Range
    Dim PI As PivotItem
    Dim Pf As PivotField
    
    Dim Arr As Variant
    Dim i As Integer
    
           
    ' 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(7, 1), TableName:="SamplePivot")
    
    ' Define the layout of the pivot table
    ' Set update to manual to avoid recomputation while laying out
    pt.ManualUpdate = True
    
    ' Set up the Pivot fields
 With pt
    .PivotFields("Process Area").Orientation = xlRowField
    .PivotFields("Unique Role ID").Orientation = xlRowField
    .PivotFields("Projects Names").Orientation = xlRowField
    .PivotFields("Role and Sub Role").Orientation = xlRowField
    .PivotFields("Employment Type").Orientation = xlRowField
    .PivotFields("Requested Name").Orientation = xlRowField
    .PivotFields("Location Role").Orientation = xlRowField
    .PivotFields("Role Description").Orientation = xlRowField
    .PivotFields("Project Description").Orientation = xlRowField
    .PivotFields("Request Status").Orientation = xlRowField
    .PivotFields("Resource Name").Orientation = xlRowField
    .PivotFields("Booking Condition").Orientation = xlRowField
    .PivotFields("Request Manager").Orientation = xlRowField
    .PivotFields("Task Start").Orientation = xlRowField
    .PivotFields("Task Finish").Orientation = xlRowField
    .PivotFields("DOP Resource Status").Orientation = xlPageField
    .PivotFields("Week Commencing").Orientation = xlColumnField
End With

'This sets each field in ascending order. It applies this even to fields
'     that are not currently in the PivotTable.
For Each Pf In pt.PivotFields
    Pf.AutoSort xlAscending, Pf.Name
    Pf.Subtotals(1) = True
    Pf.Subtotals(1) = False
Next Pf

'This changes the formatting of any field that appears in the Values area
For Each Pf In pt.DataFields
    Pf.Function = xlSum
    Pf.NumberFormat = "0.0"
Next Pf
 
'This section applies Classic PivotTable settings
'     and turns off the Contextual Tooltips and the Expand/Collapse buttons
With pt
    .InGridDropZones = True
    .RowAxisLayout xlTabularRow
    .TableStyle2 = ""
    .DisplayContextTooltips = False
    .ShowDrillIndicators = False
End With

'This ensures that only data that still exists in the data
'     that drives the PivotTable
'     will appear in the PivotTable dropdown lists
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
 
'Applying Filter at "DOP Resource Status"
With pt.PivotFields("DOP Resource Status").CurrentPage = "(All)"
     pt.PivotFields("DOP Resource Status").PivotItems("Other - please provide details in comments field").Visible = False
     pt.PivotFields("DOP Resource Status").PivotItems("(blank)").Visible = False
     pt.PivotFields("DOP Resource Status").EnableMultiplePageItems = True
End With
    
      [B][COLOR=#ff0000]Arr = WorksheetFunction.Transpose(Worksheets("Lists").Range("I1:I3").Value)
    For i = LBound(Arr) To UBound(Arr)
        Arr(i) = CStr(Arr(i))
    Next i
    Worksheets("Sheet2").Range("A8:CA8" & LastRow).AutoFilter Field:=1, Criteria1:=Arr, Operator:=xlFilterValues
[/COLOR][/B]  
  
  
    ' Setting up the data field
   With pt.PivotFields("Assignment Work")
        .Orientation = xlDataField
        .Position = 1
        .Caption = "Sum of Assignment Work"
        .Function = xlSum
    End With
                
   ' calc the pivot table
    pt.ManualUpdate = False
    
     
End Sub

 

[allExcell]

Hi Jerry,

Yes There were Blank cells withing the selected data range. As for example, for the I, J columns where date values are provided were having some initial blank cells, where i've kept some dummy values to get rid off this problem, but finally of no help. You can refer to the attached image to have an understanding about the data source. In this image, the column H is having some constant values which will be there for always to make sure Filters in Pivots selects them allways. For Blank cells in I & J, I pasted some dummy values, though it didn't solve the problem.

Any suggestion?



Sorry I couldn't insert teh image!!

 

[Jerry Sullivan]

Hi again,

Sorry but I'm not understanding what you are describing about the dummy values and whether that is working for you.

If you want to use the PivotFilters object to filter a range of dates easily, you'll need to have an enitre datasource field that Excel recognizes as having all date data types.

If you can put dummy dates (like "1/1/1980") in place of the blanks, and ensure that the field doesn't have any Text values, that should allow you to use the PivotFilters object.

You don't have to use the PivotFilters object to accomplish your task. If you prefer to leave the blanks it just makes filtering the field more difficult since the code will need to step through each PivotItem and evaluate whether the Text value represents a date within the range that you want to have visible.

 

[allExcell]

Hi Jerry,

Glad to see you online after a long time. I need some help again with another pivot. This takes the data from a defined List. The list I've already defined and it's working fine. The challenge I'm facing is, the pivot has multiple items in Datafield. This is where I'm stuck. Below code shows what exactly I want to do.

Sub MakeTable()
'declare the row, column, page and data field variables
Dim Pt As PivotTable
Dim PtCache As PivotCache
Dim vRowFields() As Variant
Dim vDataFields() As Variant
Dim vColumnFields() As Variant
Dim s As Worksheet
'
Set s = Sheets("D Planner")
'   vDataFields = Array("Sum of 7-Jan-13", "Sum of 14-Jan-13", "Sum of 21-Jan-13")
' these are the data fields and there are more than 100 such columns
  
    'create pivot cache
    Set PtCache = ActiveWorkbook.PivotCaches.Add( _
    SourceType:=xlDatabase, _
    SourceData:=s.Range("Contents")) 'list of details as source data    
'create pivot table from cache
Set Pt = PtCache.CreatePivotTable( _
    TableDestination:=Sheets("DP Out").Range("A5"), _
    TableName:="PivotD")
    
    
    
    
'     Set update to manual to avoid recomputation while laying out
    Pt.ManualUpdate = True
    
   
    
    With Pt
    .PivotFields("ID").Orientation = xlRowField
    .PivotFields("Resource").Orientation = xlRowField
    .PivotFields("Project").Orientation = xlRowField
    .PivotFields("Request Raised By").Orientation = xlRowField
    .PivotFields("Additional Comments").Orientation = xlRowField
    .PivotFields("Start Date").Orientation = xlRowField
    .PivotFields("End Date").Orientation = xlRowField
    .PivotFields("Removed Details").Orientation = xlPageField
    End With
''
    
 
'Applying Filter at "Removed Details"
With Pt.PivotFields("Removed Details").CurrentPage = "(All)"
     Pt.PivotFields("Removed Details").PivotItems("X").Visible = False
     Pt.PivotFields("Removed Details").EnableMultiplePageItems = True
End With
    
    
 
'''ReDim DataFieldArray(26 To LastCol)
'''For iCol = 26 To LastCol
'''DataFieldArray(iCol) = .Cells(1, iCol).Value
'''Next iCol
'''
'''With ActiveSheet
'''''.PivotTableWizard TableDestination:=.Range("A3")
'''''
'''''.PivotTables(1).AddFields RowFields:=RowFieldArray
'''
'''For iCol = 26 To LastCol
'''With .PivotTables(1).PivotFields(iCol)
'''.Orientation = xlDataField
'''.Position = iCol - 2
'''.Function = xlSum
'''End With
'''Next iCol
'''
'''With .PivotTables(1).DataPivotField
'''.Orientation = xlColumnField
'''.Position = 1
'''End With
    
End Sub

Any help?

 

[Jerry Sullivan]

Hi allExcel,

Try using the example linked in Post #4 of this thread.. (we've come full circle)

Make the correction noted in Post #13 so it will work with a either a 0 or 1-based array

 

[allExcell]

Hi Jerry,

I regret, I couldn't make much of it.

With my initial peace of code the Pivot is getting created except the data items. From column 26 (i.e. AA) onwards, let's say till column IB I've several columns which has to come under data items. With the below mentioned approach, I wanted to loop through multiple columns but I'm not sure about the actual code...

ReDim DataFieldArray(26 To LastCol)
For iCol = 26 To LastCol
DataFieldArray(iCol) = [COLOR=#ff0000].Cells[/COLOR](1, iCol).Value
Next iCol
With ActiveSheet
.PivotTableWizard TableDestination:=Sheets("D&OP Out").Range("A5")
'.PivotTables(1).AddFields RowFields:=RowFieldArray
For iCol = 26 To LastCol
With .PivotTables(1).PivotFields(iCol)
.Orientation = xlDataField
.Position = iCol - 2
.Function = xlSum
End With
Next iCol

Here I'm getting error message saying "Invalid or Unqualified ref.: Compile Error" while ".Cells" is highlighted.

Please can you walk me through.

Thanks & Regards

 

[Jerry Sullivan]

The specific reason for the error is that statement is trying to reference a With Object, but there isn't any in the code.

[I]With [COLOR="#FF0000"]RangeOrWorksheet Object???[/COLOR][/I]
'....
 DataFieldArray(iCol) = .Cells(1, iCol).Value
'....
[I]End with[/I]

If I may offer you some friendly advice, I'd recommend you develop your VBA skills on simpler macros before trying to take on projects like this.

Perhaps you can break out a small part of this process, try to write that isolated code, and start a new thread if you get stuck.

Good luck!

 

[allExcell]

Hi Jerry,

I got your point, and it's true that I'm trying to learn and the best possible way I found is by jumping into projects. I took up this challenge considering the fact that it will definitely be difficult but finally if I can do it I will learn a lot through this. I also understand that, in another way, it would definitely be too annoying to you if I keep on asking all sort of silly questions.

Still, pinning my hope one you and all forum users to overcome this challenge.

 

[allExcell]

Hi Jerry,

I made some progress, but again I'm stuck at some point. I would request you to have a look: Here the line highlighted with "Red" is throwing error as “add fields method of Pivot class failed:run-time error:’1004’”. And the other problem is I'm not able to add the "vDataFields" in the code.</SPAN>

Option Explicit
Sub testme()
Dim myRng As Range
Dim nRange As Range
Dim LastRow As Long
Dim FirstCol As Long
Dim LastCol As Long
Dim iCol As Long
Dim RowFieldArray() As String
Dim DataFieldArray() As String
Dim wks As Worksheet
Dim PT As PivotTable
Dim vRowFields() As Variant
Dim vDataFields() As Variant

vRowFields = Array("A", "B (Optional) ", "C ", "ID ", _
        "D ", "E* ", "Start Date (DD/MM/YYYY) * ", "End Date (DD/MM/YYYY) * ")
vDataFields = Array("7-Jan-13", "14-Jan-13", "21-Jan-13", "28-Jan-13")

Set wks = Worksheets("Base Sheet")
With wks
.Activate
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
FirstCol = 2 'skipping columns A
LastCol = 235
'Set myRng = .Range("B11", .Cells(LastRow, LastCol))
'Set nRange = .Range("B11:IB" & LastRow).AutoFilter// s.Range("Contents"))//myRng.Address(external:=True))

ReDim DataFieldArray(26 To 235)
For iCol = 26 To 235
DataFieldArray(iCol) = .Cells(1, iCol).Value
Next iCol
.Parent.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:=wks.Range("Contents")).CreatePivotTable _
TableDestination:="", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion10
End With

With ActiveSheet
.PivotTableWizard TableDestination:=.Range("A5")
[COLOR=#ff0000].PivotTables("PivotTable1").AddFields RowFields:=vRowFields[/COLOR]
 
For iCol = 26 To 235
With .PivotTables(1).PivotFields(iCol)
.Orientation = xlDataField
.Position = iCol - 2
.Function = xlSum
End With
Next iCol
With .PivotTables(1).DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
End With
End Sub

Your help would be much appreciated.

 

[Jerry Sullivan]

I don't get an error at the statement you have in red font using a mockup of your data using exact matches for the field names.

When you use field names like "E* " and "Start Date (DD/MM/YYYY) * " are you trying to use the "*" as a wildcard? That won't work, you'll need to have exact matches to each field name in the array.

If you think you have exact matches, but you're still getting an error, try using only 3 of the items and see if that works, then add or subtract items until you find the one(s) that is a mismatch.

 

[allExcell]

Hi Jerry,

You are right, I had issue with teh naming convention of headers. Now it runs fine. But to remove subtotals, I was using the following code which is actually removing the Subtotals, but here I've 2 concerns. 1st, it's taking more time than expected (I feel, as it runs in loop) and 2.) it throws a Run-time Error:"1004"/Unable to set the Subtotals property of the PivotField class , while selecting the highlighted row if I don't use error handler.

Dim pf As PivotField
On Error Resume Next
    For Each pf In .PivotTables(1).PivotFields
       [B][COLOR=#ff0000]pf.Subtotals(1) = True
[/COLOR][/B]        pf.Subtotals(1) = False
    Next pf

Any guess? and is it teh right way of using an error handler? Please advice.

Thanks & Regards