I have an Excel file,created Pivot and Two filter (Principal vendor Name and date)when am filtering by name
I would like to filter each Principal vendor Name, At a time only one value in the filter should be selected other should deselected
I tried this Code.
Dim ws As Worksheet
Set ws = Worksheets("3rd Pivot")
Dim pt As PivotTable
Set pt = ws.PivotTables("secondpivot_table")
Dim pF As PivotField
Set pF = pt.PivotFields("Principal Vendor Name")
pF.EnableMultiplePageItems = True
pF.CurrentPage = "(All)"
For i = 1 To pF.PivotItems.Count
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt.PivotCache.Refresh
k = i
For j = 1 To pF.PivotItems.Count
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
pt.PivotCache.Refresh
If i = j Then
pF.PivotItems(k).Visible = True
Else
pF.PivotItems(j).Visible = False
End If
Next j
But it showing error in this line
pF.PivotItems(j).Visible = False
"Unable To set The Visiility property of the pivotItem Class"
Something like this:
Sub Tester()
Dim ws As Worksheet, pt As PivotTable, pF As PivotField
Dim i As Long, n As Long
Set ws = Worksheets("3rd Pivot")
Set pt = ws.PivotTables("secondpivot_table")
Set pF = pt.PivotFields("Principal Vendor Name")
pF.EnableMultiplePageItems = True
pF.CurrentPage = "(All)"
For i = 1 To pF.PivotItems.Count
pF.PivotItems(i).Visible = True 'set the visible one first
'then hide the rest
For n = 1 To pF.PivotItems.Count
If n <> i Then pF.PivotItems(n).Visible = False
Next n
Next i
End Sub
Related
I'm trying to filter a filter in a pivot table in excel using VBA, but the process is spending a lot of time. The user type in a text box and click in the submit button to start the operation. My filter has more than 2.000 values. This is the code that I use in this situation.
Does it exist a fastest way to filter?
Sub a()
Dim txt1 As String
txt1 = Worksheets("Planilha1").TextBox1.Value
If Not txt1 = "" Then
Set ws = Sheets("Planilha1")
Set pt = ws.PivotTables(1)
Set pf = pt.PageFields(1)
For Each Pi In pf.PivotItems
If Not Pi = txt1 Then
pf.PivotItems(CStr(Pi)).Visible = False
End If
Next Pi
End If
End Sub
This is significantly faster:
Sub a()
Dim txt1 As String, ws As Worksheet, pt As PivotTable, pf As PivotField, pi As PivotItem
Dim t
txt1 = "Var_1099"
If Not txt1 = "" Then
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Set pf = pt.PivotFields("Col1")
t = Timer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
pt.ManualUpdate = True
For Each pi In pf.PivotItems
pi.Visible = (pi = txt1)
Next pi
Application.Calculation = xlCalculationAutomatic
pt.ManualUpdate = False
pt.Update
Debug.Print Timer - t
End If
End Sub
I am trying to filter a pivot table based on the filter of another pivot table on a different sheet with a different data source.
I have two sheets (Main and Size Actual - Style) and want to filter by "Style". The Main sheet is where I want to choose the styles to filter by and from there I want to have the other sheet update with those selected styles filtered (would help if the filtering occurred with a button). I have changed some code to account for the field (Style) that I want to filter for. Right now I have the Main sheet pivot table resetting to show all values when a filter on style is selected on Size Actual - Style. I need that to be switched and instead of clearing the filter I want it to update with the selected styles from the filter.
Option Explicit
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
On Error Resume Next
Dim wsMain As Worksheet
Dim ws As Worksheet
Dim ptMain As PivotTable
Dim pt As PivotTable
Dim pfMain As PivotField
Dim pf As PivotField
Dim pi As PivotItem
Dim bMI As Boolean
On Error Resume Next
Set wsMain = ActiveSheet
Set ptMain = Target
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each pfMain In ptMain.PageFields
bMI = pfMain.EnableMultiplePageItems
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
If ws.Name & "_" & pt <> wsMain.Name & "_" & ptMain Then
pt.ManualUpdate = True
Set pf = pt.PivotFields("Style")
bMI = pfMain.EnableMultiplePageItems
With pf
.ClearAllFilters
Select Case bMI
Case False
.CurrentPage = pfMain.CurrentPage.Value
Case True
.CurrentPage = "(All)"
For Each pi In pfMain.PivotItems
.PivotItems("Style").Visible =
pi.Visible
Next pi
.EnableMultiplePageItems = bMI
End Select
End With
bMI = False
Set pf = Nothing
pt.ManualUpdate = False
End If
Next pt
Next ws
Next pfMain
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I am trying to have the filter on the second sheet update its filter based on the selection on the first sheets style filter.
I am trying to copy Pivot table values into a new sheet using VBA. I am getting a runtime error 5. Here is my code
Sub test()
Dim shtTarget As Worksheet, pvtSht As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim field As PivotField
Dim rngSource As Range
Dim wb As Workbook: Set wb = ThisWorkbook
With wb
Set rngSource = .Sheets(2).Range("A5").CurrentRegion
Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count))
Set pc = .PivotCaches.Create(xlDatabase, rngSource.Address(False, False, xlA1, xlExternal))
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
End With
With pt.PivotFields("Concatenate")
.Orientation = xlRowField
.Position = 1
End With
pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum
With wb
Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
pvtSht.Name = "Sum of Element Entries"
pt.TableRange2.Copy
pvtSht.Range("A1").PasteSpecial xlPasteValues
End With
End Sub
My pivot table is in a range of A5:I266. The code errors out on Set pt = pc.CreatePivotTable...
Replace:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
with:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3")
I have this VBA marco which changes all the field values to Product.
Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet
Set ws = ActiveSheet
Set pt = ws.PivotTables(1)
Application.ScreenUpdating = False
pt.ManualUpdate = True
For Each pf In pt.DataFields
pf.Function = xlProduct
Next pf
pt.ManualUpdate = False
Application.ScreenUpdating = True
Set pf = Nothing
Set pt = Nothing
Set ws = Nothing
End Sub
When when I try changing xlProduct to xlCount.Numbers, the code doesn't work. Any idea how to fix this?
xlCountNums is the proper function.
https://www.thespreadsheetguru.com/blog/2014/8/12/quickly-change-pivot-table-field-calculation-from-count-to-sum
First time when I execute this function, it works as it should. Second time when I execute with some setting change not related this piece of code I get the Run-Time error 1004
With PT.PivotFields("Group")
For i = LBound(GroupNames) To UBound(GroupNames)
.PivotItems(GroupNames(i)).Position = i + 1
Next i
End With
Here is the function,
Public Sub Create_Pivots_Calculation()
Dim PT As PivotTable
Dim PC As PivotCache
Dim PTRng As Range
Dim WSTemp As Worksheet, WSSummary As Worksheet
Dim i As Integer
Set PTRng = Range("Rate_Data") 'Pivot table range
Set ECARDataRangeCalc = Range("Range_ECAR_Data") 'Where OCRTable begins to be added
Set WSTemp = Sheets.Add 'The new empty sheet
Set WSSummary = Sheets("Summary Printout") 'The output sheet
Set PC = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PTRng)
With WSTemp
'Create a pivot table with the Rate data.
'we are recreating the data with group and Well as the column and time as the row for calculation.
Set PT = .PivotTables.Add(PivotCache:=PC, TableDestination:=.Range("A100"))
PT.ErrorString = 0
PT.DisplayErrorString = True
With PT
.ColumnGrand = False
.RowGrand = False
.PivotFields("Group").Orientation = xlColumnField
.PivotFields("Well").Orientation = xlColumnField
.PivotFields("Time").Orientation = xlRowField
PT.AddDataField PT.PivotFields("ECAR"), "Average", xlAverage
'Hide the Background group
On Error Resume Next
.PivotFields("Group").PivotItems("Background").Visible = False
On Error GoTo 0
'Use average of ECAR in the data field
'Sort the pivot as per the selected group order in the GUI
With PT.PivotFields("Group")
For i = LBound(GroupNames) To UBound(GroupNames)
.PivotItems(GroupNames(i)).Position = i + 1
Next i
End With
'Clear the existing range for all data
WSSummary.Range(ECARDataRangeCalc, ECARDataRangeCalc.Offset(100, 0)).EntireRow.ClearContents
'Paste the new data in the OCR Data range
.TableRange1.Offset(1, 0).Resize(rowsize:=.TableRange1.Rows.Count - 1).Copy ECARDataRangeCalc
ECARDataRangeCalc = "Time (min)"
Set ECARDataRangeCalc = ECARDataRangeCalc.CurrentRegion 'Reset the OCRDataRange
Set ECARDataRangesCalc(0) = ECARDataRangeCalc
'On the basis of OCRDataRange build the OCRDataRange for next summary - this will be after one column where OCRDataRange ends
Set ECARDataRangeCalc = ECARDataRangeCalc.Offset(0, ECARDataRangeCalc.Columns.Count + 1)
End With
'Delete the temp sheet
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
Set PC = Nothing
Set PT = Nothing
End Sub
Any help appreciated!!!
Does changing the line:
Set PT = .PivotTables.Add(PivotCache:=PC, TableDestination:=.Range("A100"))
to
Set PT = .PivotTables.Add(PivotCache:=PC, TableDestination:=WSTemp.Range("A100"))
fix the problem for you?