Add multiple fields into Value area of (OLAP) pivot tables

[teamabc]

Hello members,

I have just starting to write <acronym title="visual basic for applications">vba</acronym> code and would appreciate anyones help on this
I have tried looking in various forums for the answers but to no success.

I am currently running code as per below for a spreadsheet that I have with a PivotTable. The code allows me to add multiple fields into the value area with a single click without having to manually click them each time.

Now I'm trying to do the same, but with OLAP / PivotTable that are connected to an external excel file (.xlsx).
Would anyone be so kind to help me rewrite my code to suit?

Not sure if this will help:
When I tried recording the macro (manually doing the ticking externally connected PivotTable) and understanding how this process works and noticed new references to [Measures], .CubeFields. Is this where I should be focusing on.

Current Code:

Sub MultiSelectAction()
Dim pt As PivotTable, pf As PivotField
Dim ws As Worksheet, i As Long
Dim pt2 As PivotTable
On Error Resume Next

Set pt = ActiveCell.PivotTable
pt.ClearTable

'InputBox
Dim myAction As String
Dim myAction2 As String

myAction = InputBox("Summarise value field by:" & vbCrLf & "1.   Sum" & vbCrLf & "2. Count" & vbCrLf & "3. Average",   "Multi Action")

If myAction = "1" Then myAction2 = "-4157" Else
If myAction = "2" Then myAction2 = "-4112" Else
If myAction = "3" Then myAction2 = "-4106" Else
If myAction = vbNullString Then Exit Sub

Application.ScreenUpdating = False

'For i = 1 To ws.PivotTables.Count
Set pt = ActiveCell.PivotTable
pt.ManualUpdate = True
For Each pf In pt.PivotFields

With pf
.Orientation = xlDataField
.Function = myAction2

End With

Next
pt.ManualUpdate = False

End Sub

 

[Jerry Sullivan]

Hi teamabc,

The code you posted starts by clearing all the fields in the PivotTable, then it adds a data field of the user selected type for each Pivotfield. Is that what you want it to do (for an OLAP)? I would think you wouldn't want to remove existing Row fields, Column fields or Report Filters. Also, don't you end up deleting many of the fields which are non-numeric, so they can't be summed or averaged?

Not sure if this will help:
When I tried recording the macro (manually doing the ticking externally connected PivotTable) and understanding how this process works and noticed new references to [Measures], .CubeFields. Is this where I should be focusing on.

Yes, recording a macro can be very useful- especially for getting the exact names of the fields for OLAP Pivots. Please post the code that you recorded.

 

[teamabc]

Hi Jerry, thanks for your help,

Yes that was my intention to clear the PivotTable, it is really down to my inexperience in coding, that was the only way I could get my exisiting code to work.

The objective of my code was to:
- Move all exisiting PivotTable Fields to the Values section (regardless of which field).
- Then allowing the user to either Sum, Count or Average all of those fields in the Values Section.

Currently the PivotTable is based on data within the same spreadsheet (Table/Range).

I'm hoping to re-write the code to do the same as above, but the data being referenced to an "External Data" source (Excel .xlsx).
External Data meaning an Excel (.xlsx) file imported from PowerQuery and added to the Data Model, and Creating a PivotTable using the "Use an external data source".

Whereas the exisitng code links to data (Range/Table) within the same spreadsheet.

I have attached a spreadsheet which might help.
https://ufile.io/809e7

The first one is the exisiting code running as it should.
The other two files is related to the new code I wish to write. The PivotTable in New Code.xlsm is connected to the data from New Code - Data.xlsx.

I really appreciate anyones help on this, many thanks.

 

[Jerry Sullivan]

Sorry, but my malware software blocked downloads from that site. I think I understand what you want without having the example workbook.

Please post the macro that is recorded when you manually add a field to the Values section of the PivotTable (you don't need to do more than one field to show the syntax).

 

[teamabc]

Ok great! This is the code when I manually add a field to the Values section of the PivotTable.
I did them on all fields, just in case you needed to see that. Thanks.

Sub Values()
'
' Values Macro
'


'
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure "[Data].[VOTER]", _
        xlSum, "Sum of VOTER"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Sum of VOTER]"), "Sum of VOTER"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure "[Data].[PARTY]", _
        xlCount, "Count of PARTY"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Count of PARTY]"), "Count of PARTY"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure _
        "[Data].[PRECINCT]", xlSum, "Sum of PRECINCT"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Sum of PRECINCT]"), "Sum of PRECINCT"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure _
        "[Data].[AGE  GROUP]", xlCount, "Count of AGE  GROUP"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Count of AGE  GROUP]"), _
        "Count of AGE  GROUP"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure _
        "[Data].[LAST VOTED]", xlCount, "Count of LAST VOTED"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Count of LAST VOTED]"), _
        "Count of LAST VOTED"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure _
        "[Data].[YEARS REG]", xlSum, "Sum of YEARS REG"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Sum of YEARS REG]"), "Sum of YEARS REG"
    ActiveSheet.PivotTables("PivotTable1").CubeFields.GetMeasure _
        "[Data].[BALLOT STATUS]", xlCount, "Count of BALLOT STATUS"
    ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
        "PivotTable1").CubeFields("[Measures].[Count of BALLOT STATUS]"), _
        "Count of BALLOT STATUS"
End Sub

 

[Jerry Sullivan]

Here is some code you can try.

Sub MultiSelectAction()
'--Adds Value fields to OLAP Cube based PivotTables
'--Clears existing PivotTable, then attmepts to add each CubeField
'    to the Values area of PivotTable based on user inputbox
'    selection of Sum, Count, or Average.
'--Fields that are not numeric type will not be added if the
'    user selection is Sum or Average.

 Dim bManualUpdate As Boolean
 Dim cbf As CubeField, cbfMeasure As CubeField
 Dim pf As PivotField
 Dim pt As PivotTable
 Dim myAction As String
 Dim sCaptionPrefix As String, sFieldName As String
 Dim myFunction As XlConsolidationFunction

 On Error Resume Next
 Set pt = ActiveCell.PivotTable

 On Error GoTo 0
 
 If pt Is Nothing Then
   MsgBox "No PivotTable selected."
   Exit Sub
 End If
 
 If Not pt.PivotCache.OLAP Then
   MsgBox "PivotTable is not based on OLAP Cube."
   Exit Sub
 End If
 
 'InputBox
 myAction = InputBox("Summarise value field by:" & vbCrLf & "1. Sum" _
   & vbCrLf & "2. Count" & vbCrLf & "3. Average", "Multi Action")

 Select Case myAction
   Case "1"
       myFunction = xlSum
       sCaptionPrefix = "Sum of "
   Case "2"
       myFunction = xlCount
       sCaptionPrefix = "Count of "
   Case "3"
       myFunction = xlAverage
       sCaptionPrefix = "Average of "
   Case Else
      Exit Sub
 End Select
 
 Application.ScreenUpdating = False
 
 bManualUpdate = pt.ManualUpdate
 '--automatic update avoids creation of invalid measures.
 pt.ManualUpdate = False
 
 pt.ClearTable
 
 For Each cbf In pt.CubeFields
   If cbf.CubeFieldType = xlHierarchy Then
      sFieldName = sCaptionPrefix & cbf.Caption
      Set cbfMeasure = pt.CubeFields.GetMeasure(cbf.Name, _
         myFunction, sFieldName)
      pt.AddDataField cbfMeasure
   End If
 Next

 pt.ManualUpdate = bManualUpdate
 Application.ScreenUpdating = True
End Sub

 

[teamabc]

Thank you so much Jerry for your time and help.
I have ran the code, but unfortunately I am running into errors.

While running:

1. the Sum scenario I get:
"run-time error '1004': the query did not run or the Data Model could not be accessed. Here's the error message we got:
MdxScript(Model) (4,54) Calculation error in measure 'Data'[Sum of AGE GROUP]: The function SUM takes an argument that evaluates to numbers or dates and cannot work with values of type String.

2. the count scenario seems to be working with no errors.

3. the Average scenario I get:
"run-time error '1004': the query did not run or the Data Model could not be accessed. Here's the error message we got:
MdxScript(Model) (4,62) Calculation error in measure 'Data'[Sum of AGE GROUP]: The function AVERAGE takes an argument that evaluates to numbers or dates and cannot work with values of type String.

When pressing the debug button it will take me to this line.
pt.AddDataField cbfMeasure

My attempts to work this out myself, i believe the code doesn't like fields which are not numeric (as you mentioned). So when I change all the data types in Power Query to Whole Number. The error goes away and the code works!

I see in your code that it mentions at the top ''--Fields that are not numeric type will not be added if the user selection is Sum or Average.". Is there anyway we can build this into the code as a cleaner method. For example, instead of bringing up the error above and not run when the code encounters field which are not numeric. Can the code ignore the error and continue to run ignoring field which are not numeric?

Thank you again, and once again appreciate the timely responses so far. I'm learning quite a bit as we go along...

 

[teamabc]

Some more observations during the weekend was that on other worksheets when running the macro. The only error that would come up was the "run-time error '1004': Application-defined or object-defined error", when debugged, it would take you back to the pt.AddDataField cbfMeasure. The macro doesn't seem to be working or looping through the CubeFields.

 

[Jerry Sullivan]

I found some inconsistent results in my testing too. Initially, the problem was limited to non-numeric fields attempting and failing to summarize by Sum and Average. After encountering those errors, the Count type also failed sporadically. It seemed the ManualUpdate=False setting had remedied that, but apparently not in your testing.

I think it would be better if we could determine whether a field is numeric before attempting to a summarize by Sum or Average. I'm not aware of any property that holds that setting. It might be possible to do a workaround of attempting to change the NumberFormat property to see if that errors.

I'll work with this some more to see if I can find a solution. Of course any suggestions from other members are encouraged.

 

[teamabc]

That is a good idea. Still mulling over some idea, but might be a bit beyond my skill set now.

If we are unable to find a way to determine whether a field is numeric before attempting to summarise by Sum or Average would a compromise be (if the user picks 1 - Sum) to just have the fields to automatically move to the Values section and summarise as sum, then the ones which are not numeric can be in whichever format (count, average, etc) the PivotTable sees fit. I think from a user point of view, this could still be useful. There may only be half a dozen of fields that need to be manually changed or removed from the Values sections.