I get an error while adding value fields to pivot - excel

G'day,
I have an excel macro where i combine my data at the end into a pivot table. However i also have a sub that adds a value field to the table. It looks like this:
Sub AddValuesField()
Dim pvt As PivotTable
Dim pf As String
Dim pf_Name As String
Dim sDatasheet As String
Dim sPivotName As String
sPivotName = "Pivot1"
sDatasheet = "Documents with extracted fields"
Sheets(sPivotName).Select
Set pvt = Sheets(sPivotName).PivotTables("PivotTable1")
pf = Sheets(sDatasheet).Range("A1").Value
pvt.AddDataField pvt.PivotFields(pf), pf, xlSum
End sub
The name of the column is stored in pf(pivotfield). I however get the most descriptive error i dream of receiving: "1004 object defined error"
I hope that someone here can help me out :)
gr,
Menno

When adding a field as Sum to your Pivot-Table, you need to add the words "Sum of" before the PivotField name.
Change your line:
pvt.AddDataField pvt.PivotFields(pf), pf, xlSum
to:
pvt.AddDataField pvt.PivotFields(pf), "Sum of " & pf, xlSum
Note: you don't need to Select your worksheet, you can simply use Set pvt = Sheets(sPivotName).PivotTables("PivotTable1") without selecting it first.

Related

Use VBA to Set Pivot Table to Specific Date Based on Another Field

I have tried many iterations that I have found on the web but cannot get this to work. I have a pivot table that I need to update weekly and I need the date to be set to a variable base on a field in the worksheet. The date is a filter. Using the code below, I can change the date to a specific date.
Sub Macro7()
'
ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
).ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
).CurrentPageName = "[Test_Data].[Date].&[2020-07-12T00:00:00]"
End Sub
However, when I try to set the date to a variable such as a string that points to the worksheet cell containing the date, it errors out, normally stating 'Unable to set the CurrentPage property of the PivotField class'. I have tried many different options and different code but nothing has worked. D2 is where the date is that changes. It updates based on a formula. I have tried also just hard coding the dates in the cell but that does not work either. Have also tried matching up date formats to the pivot, did not help. The field pulls the date of the last Friday, if that matters. I would be fine putting that into the code instead, if that would help (I tried, I got an error that the string could not be converted to the date).
Sub My_macro()
Dim str As String
str = ActiveSheet.Range("d2")
ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]" _
).ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("[Test_Data].[Date].[Date]").CurrentPage = str
End Sub
Can someone please tell me how to correct this? Have been trying for hours and hours and just cannot get it figured. Thanks. PS--I tried to upload a sheet, but I cannot figure out how, looks like I can only do pictures, so I uploaded that. Below is the pivot where the date filter is the issue, and below that is a sample of what feeds the pivot.
Edit: Have shared a sample of the file here:
https://www.dropbox.com/sh/4tzrrue0mggf6om/AAAd6024feSdc9MbCd9IZD0Wa?dl=0
When you record a macro you will get something like this
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("[_Data].[Date].[Date]"). _
CurrentPage = "[_Data].[Date].&[2019-08-16T00:00:00]"
End Sub
Even though the macro gave you that code, it will error out if you directly ran it without changing anything.
Solution: This is a very old problem which can be fixed by changing CurrentPage to CurrentPageName
Now changing it to suit your need...
Sub Sample()
Dim ws As Worksheet
Set ws = Sheet1
Dim rngDt As Range
Set rngDt = ws.Range("D2")
Dim dtString As String
dtString = Format(rngDt.Value2, "yyyy-mm-dd")
Dim pt As PivotTable
Set pt = ws.PivotTables("PivotTable2")
Dim pf As PivotField
Set pf = pt.PivotFields("[_Data].[Date].[Date]")
pf.ClearAllFilters
pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
End Sub
EDIT
May I ask you...how can I select
MULTIPLE pivots on the same sheet and do this to their filters as
well, picking the same date (cell D2) for all of them? Just repeat the
code down, subbing in the names, or would something like an array
work? Thank you again, marking yours as the answer! –
learningthisstuff 2 days ago
You can do that in loop. For each pt in
ws.PivotTables and then For each pf in pt.PivotFields :) – Siddharth
Rout 2 days ago
Thanks....where do I put those lines? I tried a couple of places I
thought made sense but keep getting errors. I will keep trying
options, wondering if I need to remove the 'set pt/pf' lines? Thank
you. – learningthisstuff 14 hours ago >
Do they have the same field "Date"? – Siddharth Rout 13 hours ago
Yes, they are all almost identical. Same filters. – learningthisstuff 11 hours ago
You can try something like this (Untested)
Sub Sample()
Dim ws As Worksheet
Set ws = Sheet1
Dim rngDt As Range
Set rngDt = ws.Range("D2")
Dim dtString As String
dtString = Format(rngDt.Value2, "yyyy-mm-dd")
Dim pt As PivotTable
Dim pf As PivotField
For Each pt In ws.PivotTables
Set pf = pt.PivotFields("[_Data].[Date].[Date]")
pf.ClearAllFilters
pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
Next pt
End Sub
EDIT
As requested by OP's edit to this answer, since there are multiple pivots, the following changes to the above code was finally made.
Sub Sample2()
Dim ws As Worksheet
Set ws = Worksheets("Sheet1")
Dim rngDt As Range
Set rngDt = ws.Range("F32")
Dim dtString As String
dtString = Format(rngDt.Value2, "yyyy-mm-dd")
Dim pt As PivotTable
Dim pf As PivotField
For Each pt In ws.PivotTables
If pt = "PivotTable2" Then
Set pf = pt.PivotFields("[_Data].[Date].[Date]")
pf.ClearAllFilters
pf.CurrentPageName = "[_Data].[Date].&[" & dtString & "T00:00:00]"
Else
Set pf = pt.PivotFields("[Sales_Data].[Date].[Date]")
pf.ClearAllFilters
pf.CurrentPageName = "[Sales_Data].[Date].&[" & dtString & "T00:00:00]"
End If
Next pt
End Sub
EDIT: Never worked with cubefields, but this seems to do what you want:
Sub My_macro()
Dim dt As Date, pt As PivotTable, pf As PivotField
dt = ActiveSheet.Range("d2")
Set pt = ActiveSheet.PivotTables(1)
Set pf = pt.PageFields("[_Data].[Date].[Date]")
With pf
.ClearAllFilters
.CubeField.EnableMultiplePageItems = True
.VisibleItemsList = _
Array("[_Data].[Date].&[" & Format(dt, "yyyy-mm-dd") & "T00:00:00]")
End With
End Sub

Pivottable' s content format

everyone,
In this pivottable I'm working on, the source data has money values and quantities. I have a filter in my pivottable in order to choose what type of data I want to see in my pivottable, whether is "V" or "Q".
My problem is that I need to format the contents of the pivottable accordingly to the type of information I'm seeing: for money values, I need to see the contents in "# ###.00 €" format; for quantity values, in "#,##0".
I already tried to use a DataRange property for the pivotfields (as you can see in the code) and even tried using NumberFormat directly on the pivotfields, but none of these worked.
Do you suggest anything to solve this?
Dim vp As Workbook
Dim type_qv As String
Dim chart_pt As PivotTable
Dim pf As PivotField
Set vp = ThisWorkbook
Set chart_pt = vp.Sheets("Chart").PivotTables("VP_table")
'this detects what type of data is being used
type_qv = vp.Sheets("Chart").Range("B2").Value
If type_qv = "Q" Then
For Each pf In chart_pt.RowFields
pf.DataRange.NumberFormat = "#,##0"
Next
End If
If type_qv = "V" Then
For Each pf In chart_pt.RowFields
pf.DataRange.NumberFormat = "# ###.00 €"
Next
End If
It's "Sum of Q" but you don't want to look at the description because they can change it and they can move the table and they can show both fields.
Dim chart_pt As PivotTable, df As PivotField
Set chart_pt = ActiveSheet.Range("A3").PivotTable
For Each df In chart_pt.DataFields
Select Case True
Case df.Name Like "*Q"
df.DataRange.NumberFormat = "#,##0"
Case df.Name Like "*V"
df.DataRange.NumberFormat = "# ###.00 €"
Case Else
df.DataRange.NumberFormat = "# ###.00"
End Select
Next

Rename filter values

I have a macro that is supposed to change the "WEEK"-filter on 5 pivot tables on the sheet "veckorapport".
This macro somehow changes "name" on the weeks to the number/text i put in the input box. See first picture, this numbers should be in descending order.
My code:
Sub Veckorapport_filter()
Dim num As String
Dim sht As Worksheet
Set sht = Sheets("Veckorapport")
num = InputBox(Prompt:="Vecka", Title:="ENTER WEEK")
sht.PivotTables("PivotTable1") _
.PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable2") _
.PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable3") _
.PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable4") _
.PivotFields("WEEK").CurrentPage = num
sht.PivotTables("PivotTable5") _
.PivotFields("WEEK").CurrentPage = num
End Sub
I need help with two things: How can i write this code so it doesn't change "name" on the Weeks in the filter?
And 2nd: How can i change back the names to the proper names in the filter-list?
Link to picture: https://imgur.com/kndEnm6
EDIT: Picture how it should look: https://imgur.com/CU9fWex
EDIT 2: Those two weeks have switched places. It should be in descending order: https://imgur.com/PVS3JMf
If you change the .CurrentPage to something that does not exist, then it will instead rename the currently selected page/item. (If you do this manually, instead of via VBA, then you will get a confirmation box, "No item of this name exists in the PivotTable report. Rename 'Old_Name' to 'New_Name'?" with an "OK" and "Cancel" button)
You can partially prevent this by ensuring that "Show Items without Data" is turned on for that field, and/or you can use WorksheetFunction.CountIf to check if that value exists before changing the .CurrentPage
As for resetting the items: Set the .Name, .Value or .Caption of the PivotItem back to the SourceName:
Dim piTMP AS PivotItem, pfTMP AS PivotField
Set pfTMP = sht.PivotTables("PivotTable1").PivotFields("WEEK")
For Each piTMP In pfTMP.PivotItems
piTMP.Name = piTMP.SourceName
Next piTMP
If the names have been switched for 2 items, you will run into an issue (the same name cannot exist twice), so you either need to check for the name being in use, or to just brute-force it with 2 loops - which is probably the simpler solution to write:
Dim piTMP AS PivotItem, pfTMP AS PivotField
Set pfTMP = sht.PivotTables("PivotTable1").PivotFields("WEEK")
'Once through
For Each piTMP In pfTMP.PivotItems
piTMP.Name = piTMP.SourceName & "_AndSomeTextThatYouNeverUse"
Next piTMP
'Twice through
For Each piTMP In pfTMP.PivotItems
piTMP.Name = piTMP.SourceName
Next piTMP
To loop through all pivot tables on the sheet:
Sub Veckorapport_filter()
Dim num As String
Dim sht As Worksheet
Set sht = Sheets("Veckorapport")
num = InputBox(Prompt:="Vecka", Title:="ENTER WEEK")
If len(num) <> 0 then
dim pt as pivottable
for each pt in sht.pivottables
with pt.PivotFields("WEEK")
.clearallfilters
.CurrentPage = num
end with
next pt
end if
End Sub

Strange error during addition of slicer cache

I'm developing an application with multiple pivot tables and slicers.
I try to prepare a template sheet and copy - paste it in order to create multiple analysis.
When I duplicate the sheet, the Slicers will be linked to both original and new pivot tables (belonging to the same SlicerCache), so I need to:
Unlink original SlicerCache from the new pivot table
Delete original Slicer from the new sheet
create new SlicerCache with the same connection settings
create new Slicer on the new sheet, belonging to the new SlicerCache
My code so far:
Function DuplicateSlicer(PreviousSlicer As Slicer) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
Dim DestWorkSheet As Worksheet
Dim SlCSequence As Integer
Dim NewSlCName As String
With PreviousSlicer
Set DestWorkSheet = .Parent
.SlicerCache.PivotTables.RemovePivotTable (DestWorkSheet.PivotTables(1))
SlCSequence = 1
Do Until GetSlicerCache(DestWorkSheet.Parent, .SlicerCache.Name & SlCSequence) Is Nothing
SlCSequence = SlCSequence + 1
Loop
NewSlCName = .SlicerCache.Name & SlCSequence
Set NewSlC = DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
Set NewSlicer = NewSlC.Slicers.Add(DestWorkSheet, Caption:=.SlicerCache.SourceName, _
Top:=.Top, Left:=.Left, Width:=.Width, Height:=.Height)
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.Delete
End With
End Function
My problem is with the line
DestWorkSheet.Parent.SlicerCaches.Add2(DestWorkSheet.PivotTables(1), _
.SlicerCache.SourceName, .SlicerCache.Name & SlCSequence)
According to MSDN help it should work even without specifying name:
The name Excel uses to reference the slicer cache (the value of the
SlicerCache.Name property). If omitted, Excel will generate a name. By
default, Excel concatenates "Slicer_" with the value of the
PivotField.Caption property for slicers with non-OLAP data sources,
... (Replacing any spaces with "_".) If required to make the name
unique in the workbook namespace, Excel adds an integer to the end of
the generated name. If you specify a name that already exists in the
workbook namespace, the Add method will fail.
However even if I use my code as above, or I just omit 3rd parameter, I keep getting
error 1004: The slicer cache already exists.
To make things even more complicated, if I use a variable for name parameter of Slicercaches.Add (NewSlCName = .SlicerCache.Name & SlCSequence) I get different one:
error: 5 "Invalid procedure call or argument"
I really don't have any idea how to fix it.
Update
I've used SlicerCaches.Add2 as that's available from the object tips.
According to another article .Add is deprecated and shouldn't be used.
I've also tried .Add instead of .Add2, it gives the same error.
So far the only approach I could make to work is this:
Create two templates with the same layout and pivot tables, one of them with slicers and the other is without.
To create a new sheet: duplicate the template without slicers, then run below code for creating the slicers in the new sheet:
Sub DuplicateSlicers(NewWorkSheet As Worksheet, SourceWorkSheet As Worksheet)
Dim SlC As SlicerCache
Dim sl As Slicer
For Each SlC In SourceWorkSheet.Parent.SlicerCaches
For Each sl In SlC.Slicers
If (sl.Parent Is SourceWorkSheet) Then
Call DuplicateSlicer(sl, NewWorkSheet)
End If
Next sl
Next SlC
End Sub
Function DuplicateSlicer(PreviousSlicer As Slicer, NewSheet As Worksheet) As Slicer
Dim NewSlC As SlicerCache
Dim NewSlicer As Slicer
If PreviousSlicer Is Nothing Then
Set DuplicateSlicer = Nothing
Exit Function
End If
On Error GoTo ErrLabel
With PreviousSlicer
Set NewSlC = NewSheet.Parent.SlicerCaches.Add2(NewSheet.PivotTables(1), _
.SlicerCache.SourceName)
Set NewSlicer = NewSlC.Slicers.Add(NewSheet, Caption:=.Caption, Top:=.Top, Left:=.Left, _
Width:=.Width, Height:=.Height)
End With
NewSlicer.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
Set DuplicateSlicer = NewSlicer
Exit Function
ErrLabel:
Debug.Print PreviousSlicer.Caption & " - " & Err.Number & ": " & Err.Description
Err.Clear
End Function

Trying to pull DataField from PivotTable using VBA in Excel

I am trying to pull both a column value and a data value out of a pivot table, using Excel.
For j = 1 To 1 'pt.RowFields(i).PivotItems.Count
sum = pt.DataFields(2).PivotItems(j)
Client = pt.RowFields(1).PivotItems(j)
Sheets("InvoiceTemplate").Range("c7").Value = Client
Sheets("InvoiceTemplate").Range("i13").Value = sum
Next
The Client value comes back exactly as expected. However, the sum value throws the error:
Unable To Get PivotItems Property from PivotField class.
With a PivotTable that looks like the below, I would expect results of Contoso and £60.50
net gross
Contoso £50.00 £60.50
Adventureworks £100 £110.00
Any idea as to what I am doing wrong? By the way, I know I have a 1 TO 1 loop, but this will be modified once this is working.
I think this does what you want:
Sub PrintPivotFields()
Dim pvt As Excel.PivotTable
Dim pvtAcctField As Excel.PivotField
Dim pvtNetField As Excel.PivotField
Dim pvtItem As Excel.PivotItem
Set pvt = ActiveCell.PivotTable
Set pvtAcctField = pvt.RowFields(1)
Set pvtNetField = pvt.DataFields(1)
For Each pvtItem In pvtAcctField.PivotItems
Debug.Print pvtItem.Name
Debug.Print Intersect(pvtItem.DataRange.EntireRow, pvtNetField.DataRange).Value
Next pvtItem
End Sub
I didn't refer to this great VBA pivot table reference by Jon Peltier, but if you do you may find a better way.

Resources