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]

I'm not able to replicate the problem you describe, so it's difficult to know what will work for you.

As a next step, try adding error handling around the two statements that are most likely to error if the field is the wrong data type for the summary type.

Add the two lines in blue font....

 For Each cbf In pt.CubeFields
   If cbf.CubeFieldType = xlHierarchy Then
      sFieldName = sCaptionPrefix & cbf.Caption
      
[B][COLOR="#0000CD"]      On Error Resume Next[/COLOR][/B]
      Set cbfMeasure = pt.CubeFields.GetMeasure(cbf.Name, _
         myFunction, sFieldName)
      pt.AddDataField cbfMeasure
[B][COLOR="#0000CD"]      On Error GoTo 0[/COLOR][/B]

   End If
 Next

 

[teamabc]

Hi Jerry, sorry for the late response,
Thank you so much for this code, this did the trick!