I'm using a small macro to add and delete Data field in pivotable.
I have buttom assigned to Buttom, by pushining the buton I can call the field but by pushing
twice it should be hidden, but it doesnt happend. One of the reason, pointed to
Set myshape = ActiveSheet.Shapes(Application.Caller). Maybe I have another problems with code.
Here's the code:
Sub Base_Salary()
Dim pt As PivotTable
Dim pf As PivotField
Dim sField As String
Dim myshape As Shape
Set pt = ActiveSheet.PivotTables(1)
Set myshape = ActiveSheet.Shapes(Application.Caller)
sField = myshape.TextFrame.Characters.Text
If pt.PivotFields(sField).Orientation = xlDataField Then
pt.PivotFields(sField).Orientation = xlHidden
myshape.Fill.ForeColor.Brightness = 0.5
Else
pt.PivotFields(sField).Orientation = xlDataField
myshape.Fill.ForeColor.Brightness = 0
End If
End Sub
Related
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
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
everyone.
I was using the Sub ClearColumns to clear all field in the column area from a Pivot Table.
Sub ClearColumns()
Dim PT As PivotTable, PF As PivotField
Set PT = ActiveSheet.PivotTables("Tb1")
With PT
For Each PF In .ColumnFields
PF.Orientation = xlHidden
Next PF
End With
Set PT = Nothing
End Sub
But now that i started using PowerPivot, the code doesnt Work. I think the fields are no longer PivotField, but CubeFields. It Is possible to make the same macro above, but for Cubefields? I tried different things, but i cant make it work.
Sub ClearColumnsPP()
Dim PT As PivotTable, PF As CubeFields
Dim strSource As String
Dim strName As String
Set PT = ActiveSheet.PivotTables("Tb1")
With PT
For Each PF In .ColumnFields
strSource = PF.SourceName
strName = PF.Name
PF(strSource, strName).Orientation = xlHidden
Next PF
End With
Set PT = Nothing
End Sub
Thanks!!
You need to check the orientation of the CubeField, and only set to hidden if it is a Column field:
Sub foo()
Dim pt As PivotTable
Dim cf As CubeField
Set pt = ActiveSheet.PivotTables("Tb1")
For Each cf In pt.CubeFields
If cf.Orientation = xlColumnField Then cf.Orientation = xlHidden
Next cf
End Sub
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?