My code runs perfect... but somehow it adds a data field every time it runs. I tried to test it if it exists with If pf.Orientation = xlDataField = True Then...("Don't add xlDataField")... Still no results.
I am pretty sure I am missing something important here otherwise the code runs good. Is there a way not to add another field if it already exists?.
Sub Import()
Dim ws As Worksheet, pvtCache As PivotCache
Dim wsp As Worksheet
Dim pf As PivotField, pt As PivotTable
Set wsp = Sheets("Pivot")
Set pt = wsp.PivotTables("PivotTable")
ActiveWorkbook.RefreshAll
Sheets("TP_Coois").Cells.Replace ",", "", xlPart
Set pf = pt.PivotFields("Sales")
If pf.Orientation = xlDataField = True Then '***I believe here is something wrong***
pt.PivotCache.Refresh
Else
With pf
.Orientation = xlDataField
.Function = xlSum
End With
pt.PivotCache.Refresh
End If
End Sub
Any Help is appreciated
Try changing your conditional from:
If pf.Orientation = xlDataField = True Then
To this:
If pf.Orientation = xlDataField Then
Related
I'm trying to automate a report creating process of which I'm stuck at a part. The code is supposed to create a pivot table and display the username in rows and count of username in value simultaneously corresponding to each other. I created the pivot table and set the username in rows by the following code.
ActiveWorkbook.PivotCaches.Create(xlDatabase, `Sheets("Days").Range("A1:B10000")).CreatePivotTable `Sheets("Days").Range("E1"), "DayData"
ActiveWorkbook.ShowPivotTableFieldList = True
With PivotFields
With ActiveSheet.PivotTables(1).PivotFields("User Name")
.Orientation = xlRowField
.Position = 1
End With
I need to know how can I make it display the count of username besides the username. Manually is can be expressed by dragging username under rows and again dragging the username under values to get count of username.
Additionally could I also enquire how do we apply filter to a pivot table
Here are some examples:
Private Sub DayDataPivotTable()
Dim wb As Workbook
Dim ws As Worksheet
Dim pCache As PivotCache
Dim pTable As PivotTable
Set wb = ActiveWorkbook
Set ws = ActiveSheet
Set pCache = wb.PivotCaches.Create(xlDatabase, ws.Range("A1:B10000"))
Set pTable = pCache.CreatePivotTable(ws.Range("E1"), "DayData")
wb.ShowPivotTableFieldList = True
With pTable
With .PivotFields("User Name")
' use it as row field:
.Orientation = xlRowField
.Position = 1
' use it additionally as data field:
.Orientation = xlDataField
.Position = 1
.Caption = "Count of Usernames"
.Function = xlCount
End With
With .RowFields(1)
' filter the row field:
.ClearAllFilters
.EnableMultiplePageItems = True
.PivotItems("John Doe").Visible = False
.PivotItems("(blank)").Visible = False
End With
With .PivotFields(2)
' use the second column as separate filter:
.Orientation = xlPageField
.Position = 1
End With
End With
End Sub
The task is to automate OLAP pivot table data filtering. There are some items in pivot field named sPivotFieldName I need to exclude. The code below works pretty fine.
With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
With .CubeFields(sCubeFieldName)
.Orientation = xlRowField
.IncludeNewItemsInFilter = True
End With
.PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With
But the problem appears when I'm trying to change cube field ".Orientation" property's value to xlPageField. Run-time error 1004 fires each time. Here's an example:
With Worksheets(sWorksheetName).PivotTables(sPivotTableName)
With .CubeFields(sCubeFieldName)
.Orientation = xlPageField
.IncludeNewItemsInFilter = True
End With
.PivotFields(sPivotFieldName).HiddenItemsList = vSomeItemsToExclude
End With
The reason seems to be that items of the fields placed in pagefield aren's visible as they are when placed for example in the rowfield (one can see them as row captions). Or maybe there's something else. What am I missing?
This functionality obviously isn't available for PageFields. Seems to me a workaround is to use the .VisibleITemsList approach instead, but make sure it doesn't include the items you want to exclude.
To do this, you need to dump all the unfiltered items to a variant, loop the variant looking for the term you want to hide, and if you find it, just replace that element for some other element that you don't want to hide. (This saves you having to create a new array without that item in it).
The tricky thing is to get a list of all unfiltered items: .VisibleItemsList won't give it to you if the PivotTable doesn't have some kind of filter applied. So we need to get sneaky by making a copy of the PivotTable, making the PageField of interest a RowField, removing all other fields, and then hoovering up the complete list of items, so we know what should be visible after we remove the ones that should be hidden.
Here's a function that handles filtering no matter whether you're dealing with a RowField or a PageField and no matter whether you want to use the .VisibleItemsList to set the filter, or the .HiddenItemsList
In your particular case, you would call it like so:
FilterOLAP SomePivotField, vSomeItemsToExclude, False
Function FilterOLAP(pf As PivotField, vList As Variant, Optional bVisible As Boolean = True)
Dim vAll As Variant
Dim dic As Object
Dim sItem As String
Dim i As Long
Dim wsTemp As Worksheet
Dim ptTemp As PivotTable
Dim pfTemp As PivotField
Dim sPrefix As String
Set dic = CreateObject("Scripting.Dictionary")
With pf
If .Orientation = xlPageField Then
pf.CubeField.EnableMultiplePageItems = True
If Not pf.CubeField.EnableMultiplePageItems Then pf.CubeField.EnableMultiplePageItems = True
End If
If bVisible Then
If .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = False
.VisibleItemsList = vList
Else
If .Orientation = xlPageField Then
' Can't use pf.HiddenItemsList on PageFields
' We'll need to manipulate a copy of the PT to get a complete list of visible fields
Set wsTemp = ActiveWorkbook.Worksheets.Add
pf.Parent.TableRange2.Copy wsTemp.Range("A1")
Set ptTemp = wsTemp.Range("A1").PivotTable
With ptTemp
.ColumnGrand = False
.RowGrand = False
.ManualUpdate = True
For Each pfTemp In .VisibleFields
With pfTemp
If .Name <> pf.Name And .Name <> "Values" And .CubeField.Orientation <> xlDataField Then .CubeField.Orientation = xlHidden
End With
Next pfTemp
.ManualUpdate = False
End With
sPrefix = Left(pf.Name, InStrRev(pf.Name, ".")) & "&["
Set pfTemp = ptTemp.PivotFields(pf.Name)
pfTemp.CubeField.Orientation = xlRowField
pfTemp.ClearAllFilters
vAll = Application.Transpose(pfTemp.DataRange)
For i = 1 To UBound(vAll)
vAll(i) = sPrefix & vAll(i) & "]"
dic.Add vAll(i), i
Next i
'Find an item that we know is visible
For i = 1 To UBound(vList)
If Not dic.exists(vList(i)) Then
sItem = vList(i)
Exit For
End If
Next i
'Change any items that should be hidden to sItem
For i = 1 To UBound(vList)
If dic.exists(vList(i)) Then
vAll(dic.Item(vList(i))) = sItem
End If
Next i
.VisibleItemsList = vAll
Application.DisplayAlerts = False
wsTemp.Delete
Application.DisplayAlerts = True
Else
If Not .CubeField.IncludeNewItemsInFilter Then .CubeField.IncludeNewItemsInFilter = True
.HiddenItemsList = vList
End If
End If
End With
End Function
Someone please, show me example how it works((
Dim pt As PivotTable
Dim pf As PivotField
Set pt = ActiveSheet.PivotTables("Сводная таблица2")
Set pf = pt.PivotFields("[груп бай].[Название клиента].[Название клиента]")
wList = "[груп бай].[Название клиента].&[ООО ""Сеть автоматизированных пунктов выдачи""]"
FilterOLAP(pf, wList, FAlse)
debuging here
> If .Name <> pf.Name And .Name <> "Values" And .CubeField.Orientation
> <> xlDataField Then .CubeField.Orientation = xlHidden
With the help of below coding, I am able to create Pivot table. I am facing problem when I change the table destination to another sheet.
If I use below coding, it is working fine.
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=Range("A1"))
If I use below coding, it is showing error as invalid procedure.
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=ThisWorkbook.Sheets("Sheet4").Range("A1"))
Complete code.
Dim PT As PivotTable
Dim PTCache As PivotCache
Worksheets("Sheet3").Select
Set PT = ActiveSheet.PivotTables.Add(PivotCache:=PTCache, Tabledestination:=ThisWorkbook.Sheets("Sheet4").Range("A1"))
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Cells(1, 1).CurrentRegion)
With PT
.PivotFields("phase").Orientation = xlColumnField
.PivotFields("month").Orientation = xlColumnField
.PivotFields("vertical").Orientation = xlRowField
.PivotFields("pp").Orientation = xlDataField
.DisplayFieldCaptions = False
End With
Try with
Tabledestination:=ThisWorkbook.Sheets("Sheet4").Name & "!R1C1"
Use Row number and Column number referencing syntax.
This works for me:
Dim PT As PivotTable
Dim PTCache As PivotCache
Worksheets("Sheet3").Select
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, Cells(1, 1).CurrentRegion)
Set PT = PTCache.CreatePivotTable("Sheet4!R1C1", "PivotPP")
With PT
.PivotFields("phase").Orientation = xlColumnField
.PivotFields("month").Orientation = xlColumnField
.PivotFields("vertical").Orientation = xlRowField
.PivotFields("pp").Orientation = xlDataField
.DisplayFieldCaptions = False
End With
I am trying to create a Pivot table on a newsheet using dynamic range, but getting an error that says:
Run time error: 13 Type Mismatch
Googled the error and as per my understanding, the code contains data type that is not matched correctly, but I am not able to figure out where is the error:
Using Excel 2016.
Sub EEE()
Dim PrevSheet As Worksheet
Set PrevSheet = ActiveSheet
Sheets.Add.Name = "Pivottable"
PrevSheet.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveSheet.UsedRange, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivottable!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15
Sheets("Pivottable").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Faculty")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("PivotTable1").PivotFields("NPS")
.Orientation = xlColumnField
.Position = 1
End With
End Sub
Modified Code - Working
Sub EEE()
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable
Dim ws As Worksheet
Set rng = ActiveSheet.Range("A1").CurrentRegion
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabaseSourceData:=rng.Address)
Set ws = ActiveWorkbook.Worksheets.Add
ws.Name = "NewSheet"
Set pt = pc.CreatePivotTable(TableDestination:=Range("A3"),TableName:="pvttbl")
With pt
.PivotFields("Faculty").Orientation = xlRowField
ActiveSheet.PivotTables("pvttbl").AddDataField ActiveSheet.PivotTable "pvttbl").PivotFields("NPS"), "Count of NPS", xlCount
.PivotFields("NPS").Orientation = xlColumnField
End With
End Sub
You don't say what line is giving the error. But there's a couple of possible culprits.
The line SourceData:=ActiveSheet.UsedRange says "Hey, go make the PivotTable out of everything you find on the active sheet". Not a good idea. Use the exact range where the data is. Either select a cell where there block of data is and use the CurrentRegion e.g.
SourceData:= Activesheet.Range("A1").CurrentRegion
...or even better, turn that SourceData into an Excel Table aka ListObject earlier in the code, and reference that ListObject:
SourceData:= "Table1"
Your code will also fail if you try to run it more than once and you haven't deleted the sheet called "PivotTable" that it created last time.
Here's how I would code this up:
Option Explicit
Sub EEE()
Dim rng As Range
Dim pc As PivotCache
Dim pt As PivotTable
Dim pf As PivotField
Dim ws As Worksheet
Set rng = Range("A1").CurrentRegion '<- Change to the address of the top left cell in your data.
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng.Address)
Set ws = ActiveWorkbook.Worksheets.Add
Set pt = pc.CreatePivotTable(TableDestination:=Range("A1"))
With pt
.PivotFields("Faculty").Orientation = xlRowField
.PivotFields("NPS").Orientation = xlColumnField
End With
End Sub
I am trying to create a pivot table on a new sheet. Additionally, I would like to create another call to create another different pivot table using the same data from the first data sheet.
having trouble with the macro below. I think it is a small error, but can't figure it out.
Sub Macro2()
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim DataRng As Range
Dim TableDest As Range
Dim ws As Worksheet
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = ActiveSheet.Name
'set data range for Pivot Table -- ' conversion of R1C1:R & FinalRow & C15
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))
Set ws = Worksheets.Add
ws.Name = "Travel Payment Data by Employee"
'set range for Pivot table placement -- Conversion of R1C1
Set TableDest = Sheets("Travel Payment Data by Employee").Cells(1, 1)
Set PvtCache = ActiveWorkbook.PivotCaches.Create(xlDatabase, DataRng, xlPivotTableVersion15)
'check if "PivotTable4" Pivot Table already created (in past runs of this Macro)
Set PvtTbl = ActiveWorkbook.Sheets("Travel Payment Data by Employee").PivotTables("PivotTable4")
With PvtTbl.PivotFields("Security Org")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("Fiscal Month")
.Orientation = xlRowField
.Position = 2
End With
With PvtTbl.PivotFields("Budget Org")
.Orientation = xlRowField
.Position = 3
End With
With PvtTbl.PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 4
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlRowField
.Position = 5
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlColumnField
.Position = 1
End With
PvtTbl.AddDataField ActiveSheet.PivotTables( _
"PivotTable2").PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
End Sub
Consider the following adjustment with a subroutine calling a function, passing in new worksheet names for new identical pivot tables. If you do not intend identical pivots, adjust them in code conditionally by sheet name or copies of function. The main changes from your code are as follows:
ACTIVE SHEET: Remove the need to search ActiveSheet.Name as adding more worksheets will alter active sheets. Simply hard-code or pass as parameter the data source.
OBJECT CHECK: You need to check if Worksheet exits and PivotTable exists. For these, you will need to iterate through all current such objects and conditionally set worksheet, pivot table objects (see For...Next loops and If ... Is Nothing checks).
For PivotField, since Dollar Amounts will exist in Pivot Table data source but not necessarily display, iterating through all of them might not work like above. So conditionally add only if does not error out see On Resume Next handle.
VBA
Option Explicit
Public Sub RunPivots()
Call BuildPivot("Travel Payment Data by Employee")
Call BuildPivot("Other Worksheet")
Call BuildPivot("Still More Worksheet")
End Sub
Function BuildPivot(paramSheet As String)
On Error GoTo ErrHandle
Dim FinalRow As Long
Dim DataSheet As String
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
Dim DataRng As Range
Dim TableDest As Range
Dim ws As Worksheet
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
DataSheet = "DataSourceWorksheet"
' set data range for Pivot Table
Set DataRng = Sheets(DataSheet).Range(Cells(1, 1), Cells(FinalRow, 15))
' check if worksheet exists
Dim currws As Worksheet
For Each currws In ActiveWorkbook.Worksheets
If currws.Name = paramSheet Then
Set ws = Worksheets(paramSheet)
Exit For
End If
Next currws
' create new worksheet if does not exist
If ws Is Nothing Then
Set ws = Worksheets.Add
ws.Name = paramSheet
End If
' set range for Pivot table placement
Set TableDest = Sheets(paramSheet).Cells(1, 1)
' create pivot cache
Set PvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=DataRng, _
Version:=xlPivotTableVersion15)
'check if "PivotTable4" Pivot Table exists
Dim currpvt As PivotTable
For Each currpvt In ws.PivotTables
If currpvt.Name = "PivotTable4" Then
Set PvtTbl = ws.PivotTables("PivotTable4")
Exit For
End If
Next currpvt
' create new pivot table if does not exist
If PvtTbl Is Nothing Then
Set PvtTbl = PvtCache.CreatePivotTable( _
TableDestination:=TableDest, _
TableName:="PivotTable4")
End If
With PvtTbl.PivotFields("Security Org")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("Fiscal Month")
.Orientation = xlRowField
.Position = 2
End With
With PvtTbl.PivotFields("Budget Org")
.Orientation = xlRowField
.Position = 3
End With
With PvtTbl.PivotFields("Vendor Name")
.Orientation = xlRowField
.Position = 4
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlRowField
.Position = 5
End With
With PvtTbl.PivotFields("Fiscal Year")
.Orientation = xlColumnField
.Position = 1
End With
' Add data field if does not exist
On Error Resume Next
PvtTbl.AddDataField PvtTbl.PivotFields("Dollar Amount"), "Sum of Dollar Amount", xlSum
Exit Function
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Exit Function
End Function