I am trying to update the pivot with VBA, However my below code is not getting updated once the first criteria is Hidden rest is not getting hidden automatically, I am lost with this. Any support will be highly helpful, attached is screenshot post code execution.
Sub Pivotselection()
Sheets("Daily Facing Service by WH").Select
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("Ordtype").Orientation = xlHidden
ActiveSheet.PivotTables("PivotTable1").PivotFields("TOTLNS").Orientation = xlHidden
ActiveSheet.PivotTables("PivotTable1").PivotFields("TOTFCA").Orientation = xlHidden
With ActiveSheet.PivotTables("PivotTable1").PivotFields("WH")
.Orientation = xlColumnField
.Position = 1
End With
Application.ScreenUpdating = True
Sheets("Monthly Facing Service").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Ordtype").Orientation = xlHidden
Sheets("Calculations").Select
Range("E8").Select
End Sub
You've named them incorrectly. As they have been added to the value field already there name has changed so you need to reference them with their new name
Sub Pivotselection()
Sheets("Daily Facing Service by WH").Select
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of Ordtype").Orientation = xlHidden
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of TOTLNS").Orientation = xlHidden
ActiveSheet.PivotTables("PivotTable1").PivotFields("Sum of TOTFCA").Orientation = xlHidden
With ActiveSheet.PivotTables("PivotTable1").PivotFields("WH")
.Orientation = xlColumnField
.Position = 1
End With
Application.ScreenUpdating = True
Sheets("Monthly Facing Service").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Ordtype").Orientation = xlHidden
Sheets("Calculations").Select
Range("E8").Select
End Sub
Also I'd get rid of your .Select statements. They don't seem to be doing anything
Related
I have tried via a named range however for some reason the equation keeps changing automatically within the named range after I run the a macro. So I attempted to set the range within the macro itself.
I am writing a macro that will look through a slicer and save the 2 sheets as a PDF. The 2nd tab has pivot which area range will change each time a slicer changes. Can someone help me so that this will print to PDF dynamically?
Sub Loopexport()
Dim ws2 As Worksheet
Dim PT As PivotTable
'Hide non-printable sheets
Sheets("Overview").Visible = False
Sheets("KPExport").Visible = False
Set ws2 = Sheets("Id CUps")
Set PT = ws2.PivotTables(1)
'Set print areas
Sheets("Stats").PageSetup.PrintArea = "$A$1:$M$39"
ws2.PageSetup.PrintArea = PT.TableRange2 'this is where I am receiving the type mismatch. and the = "My named range" kept changing automatically at the end.
With Sheets("Id CUps").Columns("D:D")
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Print Regions
'Export N1
ActiveWorkbook.SlicerCaches("Slicer_Dt").VisibleSlicerItemsList = Array("[UserID].[Dept].&[N1]")
ChDir ("C:\My Docs\A\B\Export")
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:="C:\My Docs\A\B\Export\N1 - " & Format(Now(), "YYYY") & "M" & Format(Now(), "MM")
End Sub
ws2.PageSetup.PrintArea = PT.TableRange2.Address
I am creating a pivot table. I have three sheets and I am creating the pivot table in sheet CAT_Pivot with data in a preparation sheet.
I am able to achieve my target, but I get a runtime error at the end of the execution. The runtime error states
Application Defined or object Defined Error.
To add to that, how do I calculate the values in the pivot table? I used .function = xlcount and I didn't succeed.
Here is my code:
Sub AutoPivot()
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
Dim PvtSht As Worksheet
' set Pivot Cache for Pivot Table
' Your range is static, there are ways to refer to a dynamic range
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Preparation sheet!R1C1:R1048576C8")
' set the Pivot table's sheet
Set PvtSht = Worksheets("CAT_Pivot")
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set PvtTbl = PvtSht.PivotTables("PivotTable1") ' check if "PivotTable7" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If PvtTbl Is Nothing Then ' Pivot table object is nothing >> create it
' create a new Pivot Table in "PivotTable4" sheet
Set PvtTbl = PvtSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=PvtSht.Range("A3"), TableName:="PivotTable1")
With PvtTbl
With .PivotFields("Category")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Colour")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Category")
.PivotItems("DG-035583").Visible = False
.PivotItems("DG-048917").Visible = False
.PivotItems("DG-Series").Visible = False
.PivotItems("gn").Visible = False
.PivotItems("yl").Visible = False
.PivotItems("(blank)").Visible = False
End With
With .PivotFields("Colour")
.PivotItems("(blank)").Visible = False
End With
End With
Else
' just refresh the Pivot cache with the updated Range
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End If
End Sub
The problem is that you are trying to write nested with statements. Try to rewrite your code from scratch without using more than one with at a time.
E.g., this part is bad:
With PvtTbl
With .PivotFields("Category")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("Colour")
.Orientation = xlColumnField
.Position = 1
End With
With .PivotFields("Category")
.PivotItems("DG-035583").Visible = False
.PivotItems("DG-048917").Visible = False
.PivotItems("DG-Series").Visible = False
.PivotItems("gn").Visible = False
.PivotItems("yl").Visible = False
.PivotItems("(blank)").Visible = False
End With
With .PivotFields("Colour")
.PivotItems("(blank)").Visible = False
End With
End With
You may rewrite it like this:
With PvtTbl.PivotFields("Category")
.Orientation = xlRowField
.Position = 1
End With
With PvtTbl.PivotFields("Colour")
.Orientation = xlColumnField
.Position = 1
End With
Reference for nested if - Nested With Statement hiearchy
Cheers!
Edit: Actually nested if is not that bad, it even works. But still, its a bit confusing.
I wrote a Web Query macro to import financial statements from Yahoo Finance based on the value in cell A1. It was working seamlessly for the past few weeks, but suddenly, it no longer returns any data (but does not generate an error). If anyone has any insights, I would appreciate your guidance. I have posted the code below--thank you!
Sub ThreeFinancialStatements()
On Error GoTo Explanation
Rows("2:1000").Select
Selection.ClearContents
Columns("B:AAT").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
Dim inTicker As String
inTicker = Range("A1")
ActiveSheet.Name = UCase(inTicker)
GetFinStats inTicker
Exit Sub
Explanation:
MsgBox "Please make sure you type a valid stock ticker symbol into cell A1 and are not trying to create a duplicate sheet." & _
vbLf & " " & _
vbLf & "Also, for companies with different classes of shares (e.g. Berkshire Hathaway), use a hyphen to designate the ticker symbol instead of a period (e.g. BRK-A)." & _
vbLf & " " & _
vbLf & "Please also note that not every company has three years of financial statements, so data may appear incomplete or missing for some companies.", _
, "Error"
Exit Sub
End Sub
Sub GetFinStats(inTicker As String)
'
' GetBalSheet Macro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/bs?s=" & inTicker & "+Balance+Sheet&annual", Destination:= _
Range("$D$1"))
.Name = "bs?s=PEP+Balance+Sheet&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/is?s=" & inTicker & "+Income+Statement&annual", Destination _
:=Range("$J$1"))
.Name = "is?s=PEP+Income+Statement&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/cf?s=" & inTicker & "+Cash+Flow&annual", Destination:= _
Range("$P$1"))
.Name = "cf?s=PEP+Cash+Flow&annual"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "9"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("A3").Select
ActiveCell.FormulaR1C1 = "Current Ratio"
Range("A4").Select
ActiveCell.FormulaR1C1 = "Quick Ratio"
Range("A5").Select
ActiveCell.FormulaR1C1 = "Cash Ratio"
Range("A6").Select
Range("A7").Select
ActiveCell.FormulaR1C1 = "Revenue Growth Rate"
Range("A9").Select
Columns("A:A").ColumnWidth = 21.86
ActiveCell.FormulaR1C1 = "ROA"
Range("A10").Select
ActiveCell.FormulaR1C1 = "ROE"
Range("A11").Select
ActiveCell.FormulaR1C1 = "ROIC"
Range("B3").Select
ActiveCell.Formula = "=F11/F28"
Range("B4").Select
ActiveCell.Formula = "=(F11-F8)/F28"
Range("B5").Select
ActiveCell.Formula = "=F5/F28"
Range("B7").Select
ActiveCell.Formula = "=(L2/N2)^(1/2)-1"
Range("B9").Select
ActiveCell.Formula = "=L35/SUM(F12:F18)"
Range("B10").Select
ActiveCell.Formula = "=L35/F47"
Range("B11").Select
ActiveCell.Formula = "=L35/(F47+SUM(F29:F33))"
Range("B3").Select
Selection.NumberFormat = "0.00"
Range("B4").Select
Selection.NumberFormat = "0.00"
Range("B5").Select
Selection.NumberFormat = "0.00"
Range("B7").Select
Selection.NumberFormat = "0.00%"
Range("B9").Select
Selection.NumberFormat = "0.00%"
Range("B10").Select
Selection.NumberFormat = "0.00%"
Range("B11").Select
Selection.NumberFormat = "0.00%"
Range("A1").Select
End Sub
Your code is obviously working against a specific worksheet:
Rows("2:1000").Select
But what sheet is that? Only you can know that.
As written, it's whatever the active worksheet is, regardless of how much sense that makes.
Unqualified, these functions all implicitly refer to the ActiveSheet:
Range
Cells
Columns
Rows
Names
So you need to qualify them. And you do that by specifying a specific Worksheet object they should be working with - suppose that's DataSheet (I've no idea):
DataSheet.Rows("2:1000").Select
That would .Select the specified rows on the worksheet pointed to by the DataSheet object.
By why do you need to .Select it? This:
Rows("2:1000").Select
Selection.ClearContents
Could just as well be:
DataSheet.Rows("2:1000").ClearContents
Or better - assuming your data is formatted as a table (seems it looks like one anyway - so why not use the ListObjects API?):
DataSheet.ListObjects("DataTable").DataBodyRange.Delete
Sounds like that instruction has just replaced all the .Select and .ClearContents going on here. Note that .Select mimicks user action - the user clicking on a cell (or anything really) and selecting it. You have programmatic access to the entire object model - you never need to .Select anything!
Dim inTicker As String
inTicker = Range("A1")
Here you're implicitly reading from the active sheet, but you're also implicitly converting a Variant (the cell's value) into a String, which may or may not succeed. If A1 contains an error value (e.g. #REF!), the instruction fails.
With DataSheet.Range("A1")
If Not IsError(.Value) Then
inTicker = CStr(.Value)
Else
'decide what to do then
End If
End With
Your error-handling subroutine should at least Debug.Print Err.Number, Err.Description so that you have a bit of a clue about why things blew up. Right now it's assuming a reason for failure, and as you saw, Excel is full of traps.
Also you're using vbLf, but that's only half of a proper Windows newline character. Use vbNewLine if you're not sure what that is.
An Exit Sub instruction just before an End Sub token is completely useless.
Sub GetFinStats(inTicker As String)
The procedure is implicitly Public, and inTicker is implicitly passed ByRef. Kudos for giving it an explicit type!
This would be better:
Private Sub GetFinStats(ByVal inTicker As String)
With ActiveSheet.QueryTables
At least that's explicit about using the active sheet. But should it use the active sheet, or a specific sheet? And what happens to the query tables that were already there?
I strongly recommend you type this in the immediate pane:
?ThisWorkbook.Connections.Count
If the number is greater than the number of .QueryTables.Add calls you have in your procedure (likely), you have quite a problem there: I suspect you have over a hundred connections in the workbook, and clicking the "Refresh All" button takes forever to finish, and it's fairly possible that finance.yahoo.com is receiving dozens of requests from a single IP in a very limited amount of time, and refuses to serve them.
Delete all unused workbook connections. And then fix the implicit ActiveSheet references there too, and get rid of all these useless .Select calls:
With TheSpecificSheet
With .QueryTables.Add( ... )
End With
With .QueryTables.Add( ... )
End With
With .QueryTables.Add( ... )
End With
'assgin .Value, not .FormulaR1C1; you're not entering a R1C1 formula anyway
.Range("A3").Value = "Current Ratio"
.Range("A4").Value = "Quick Ratio"
.Range("A5").Value = "Cash Ratio"
End With
Consecutive .Select calls mean all but the last one serve a purpose, if any:
Range("A6").Select
Range("A7").Select
Again, don't assign ActiveCell when you can assign .Range("A7").Value directly.
And you can set number formats for a range of cells:
.Range("B3:B11").NumberFormat = "0.00%"
You can still retrieve the necessary data by parsing JSON response either from
https://finance.yahoo.com/quote/AAPL/financials(extracting data from HTML content, AAPL here just for example)
or via API
https://query1.finance.yahoo.com/v10/finance/quoteSummary/AAPL?lang=en-US®ion=US&modules=incomeStatementHistory%2CcashflowStatementHistory%2CbalanceSheetHistory%2CincomeStatementHistoryQuarterly%2CcashflowStatementHistoryQuarterly%2CbalanceSheetHistoryQuarterly%2Cearnings
You may use the below VBA code to parse response and output result. Import JSON.bas module into the VBA project for JSON processing. Here are Sub Test_query1_finance_yahoo_com() to get data via API and Test_finance_yahoo_com_quote to extract data from HTML content:
Option Explicit
Sub Test_query1_finance_yahoo_com()
Dim sSymbol As String
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
sSymbol = "AAPL"
' Get JSON via API
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", "https://query1.finance.yahoo.com/v10/finance/quoteSummary/" & sSymbol & "?lang=en-US®ion=US&modules=incomeStatementHistory%2CcashflowStatementHistory%2CbalanceSheetHistory%2CincomeStatementHistoryQuarterly%2CcashflowStatementHistoryQuarterly%2CbalanceSheetHistoryQuarterly%2Cearnings", False
.Send
sJSONString = .ResponseText
End With
' Parse JSON response
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
Exit Sub
End If
' Pick core data
Set vJSON = vJSON("quoteSummary")("result")(0)
' Output
QuoteDataOutput vJSON
MsgBox "Completed"
End Sub
Sub Test_finance_yahoo_com_quote()
Dim sSymbol As String
Dim sJSONString As String
Dim vJSON As Variant
Dim sState As String
sSymbol = "AAPL"
' Get webpage HTML response
With CreateObject("Msxml2.XMLHTTP")
.Open "GET", "https://finance.yahoo.com/quote/" & sSymbol & "/financials", False
.Send
sJSONString = .ResponseText
End With
' Extract JSON from HTML content
sJSONString = "{" & Split(sJSONString, "root.App.main = {")(1)
sJSONString = Split(sJSONString, "}(this));")(0)
sJSONString = Left(sJSONString, InStrRev(sJSONString, "}"))
' Parse JSON response
JSON.Parse sJSONString, vJSON, sState
If sState = "Error" Then
MsgBox "Invalid JSON"
Exit Sub
End If
' Pick core data
Set vJSON = vJSON("context")("dispatcher")("stores")("QuoteSummaryStore")
' Output
QuoteDataOutput vJSON
MsgBox "Completed"
End Sub
Sub QuoteDataOutput(vJSON)
Const Transposed = True ' Output option
Dim oItems As Object
Dim vItem
Dim aRows()
Dim aHeader()
' Fetch main structures available from JSON object to dictionary
Set oItems = CreateObject("Scripting.Dictionary")
With oItems
.Add "IncomeStatementY", vJSON("incomeStatementHistory")("incomeStatementHistory")
.Add "IncomeStatementQ", vJSON("incomeStatementHistoryQuarterly")("incomeStatementHistory")
.Add "CashflowY", vJSON("cashflowStatementHistory")("cashflowStatements")
.Add "CashflowQ", vJSON("cashflowStatementHistoryQuarterly")("cashflowStatements")
.Add "BalanceSheetY", vJSON("balanceSheetHistory")("balanceSheetStatements")
.Add "BalanceSheetQ", vJSON("balanceSheetHistoryQuarterly")("balanceSheetStatements")
.Add "EarningsChartQ", vJSON("earnings")("earningsChart")("quarterly")
.Add "FinancialsChartY", vJSON("earnings")("financialsChart")("yearly")
.Add "FinancialsChartQ", vJSON("earnings")("financialsChart")("quarterly")
End With
' Output each data set to separate worksheet
For Each vItem In oItems
' Convert each data set to array
JSON.ToArray oItems(vItem), aRows, aHeader
' Output array to worksheet
With GetSheet((vItem))
.Cells.Delete
If Transposed Then
Output2DArray .Cells(1, 1), WorksheetFunction.Transpose(aHeader)
Output2DArray .Cells(1, 2), WorksheetFunction.Transpose(aRows)
Else
OutputArray .Cells(1, 1), aHeader
Output2DArray .Cells(2, 1), aRows
End If
.Columns.AutoFit
End With
Next
End Sub
Function GetSheet(sName As String, Optional bCreate = True) As Worksheet
On Error Resume Next
Set GetSheet = ThisWorkbook.Sheets(sName)
If Err Then
If bCreate Then
Set GetSheet = ThisWorkbook.Sheets.Add(, ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
GetSheet.Name = sName
End If
Err.Clear
End If
End Function
Sub OutputArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize(1, UBound(aCells) - LBound(aCells) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Sub Output2DArray(oDstRng As Range, aCells As Variant)
With oDstRng
.Parent.Select
With .Resize( _
UBound(aCells, 1) - LBound(aCells, 1) + 1, _
UBound(aCells, 2) - LBound(aCells, 2) + 1)
.NumberFormat = "#"
.Value = aCells
End With
End With
End Sub
Finally Sub QuoteDataOutput(vJSON) input is a JSON object, to make it clear how the necessary data is being extracted from it, you may save the JSON string to file, copy the contents and paste it to any JSON viewer for further study. I use online tool http://jsonviewer.stack.hu, target element structure is shown below:
The output for me is as follows (first worksheet shown):
There are 9 main sections, the relevant part of the data is extracted and output to 9 worksheets:
IncomeStatementY
IncomeStatementQ
CashflowY
CashflowQ
BalanceSheetY
BalanceSheetQ
EarningsChartQ
FinancialsChartY
FinancialsChartQ
Having that example you can extract the data you need from that JSON response.
It turns out that Yahoo ended the application from which the web query drew its data. Thank you for all your tips.
In this, not all the time, I will have the option 12L or 03A when I pull the report. How do I apply an if statement which would filter (deselect) only when these options are available.
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Item").CurrentPage = "10"
ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group"). _
CurrentPage = "(All)"
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group")
.PivotItems("03A").Visible = False
.PivotItems("12L").Visible = False
End With
ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group"). _
EnableMultiplePageItems = True
Range("A7").Select
ActiveSheet.PivotTables("PivotTable1").InnerDetail = "Contract"
Selection.ShowDetail = True
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
End Sub
I assume this
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group")
.PivotItems("03A").Visible = False
.PivotItems("12L").Visible = False
End With
generates error when "03A" and "12L" are not available. You can just add On Error Resume Next.
On Error Resume Next 'In case of error, go to next line
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Purchasing Group")
.PivotItems("03A").Visible = False
.PivotItems("12L").Visible = False
End With
On Error GoTo 0 'Disable any enabled error handler
I am converting a table into Pivot and then to a CSV file. I want to remove the subtotals of the pivot table. So far: this is my progress.
MACRO CreatePivot:
Sub CreatePivot()
' Creates a PivotTable report from the table on Sheet1
' by using the PivotTableWizard method with the PivotFields
' method to specify the fields in the PivotTable.
Dim objTable As PivotTable, objField As PivotField
' Select the sheet and first cell of the table that contains the data.
ActiveWorkbook.Sheets("Employees").Select
Range("A1").Select
' Create the PivotTable object based on the Employee data on Sheet1.
Set objTable = Sheet1.PivotTableWizard
' Specify row and column fields.
Set objField = objTable.PivotFields("Supplier")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Part #")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Tracking #")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Packing/Inv#")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("PO#")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Ship Date")
objField.Orientation = xlRowField
' Specify a data field with its summary
' function and format.
Set objField = objTable.PivotFields("Qty")
objField.Orientation = xlDataField
objField.Function = xlSum
' Specify a page field.
Set objField = objTable.PivotFields("Carrier")
objField.Orientation = xlPageField
' Prompt the user whether to delete the PivotTable.
Application.DisplayAlerts = False
If MsgBox("Delete the PivotTable?", vbYesNo) = vbYes Then
ActiveSheet.Delete
End If
Application.DisplayAlerts = True
End Sub
Also I just added MACRO DesigningPivotTable:
Sub DesigningPivotTable()
Dim PT As PivotTable
Set PT = ActiveSheet.PivotTables(1)
PT.TableRange1.Select
With PT
.NullString = 0
.RepeatAllLabels Repeat:=xlRepeatLabels
.ColumnGrand = False
.RowGrand = 0
.PivotFields("Order #").Subtotals(1) = True
.PivotFields("Order #").Subtotals(1) = False
End With
End Sub
According to Excel 2013 Pivot Table Data Crunching; you can turn on the first subtotal, and this method automatically disables all the other subtotals, hence: it is not working for me:
.PivotFields("Order #").Subtotals(1) = True
.PivotFields("Order #").Subtotals(1) = False
All, thanks to some more research I found the solution
Sub PivotTableLayout2b()
Dim PvtTbl As PivotTable
Dim pvtFld As PivotField
Set PvtTbl = ActiveSheet.PivotTables(1)
'hide Subtotals for all fields in the PivotTable .
With PvtTbl
For Each pvtFld In .PivotFields
pvtFld.Subtotals(1) = True
pvtFld.Subtotals(1) = False
Next pvtFld
End With
End Sub
.PivotFields("Pivot Field Name").Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
it is not better is it just to make it clear
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
surely sets all possible subtotals to false, in one go.
I found I did not need to set the subtotal to 'true' first. Setting it directly to false was fine. Example below:
With PvtTbl
For Each pvtFld In .PivotFields
pvtFld.Subtotals(1) = False
Next pvtFld
End With
I think it's easier.
ActiveSheet.PivotTables("Supplier").RowGrand = False
ActiveSheet.PivotTables("Supplier").ColumnGrand = False
Another way is to set each PivotField Subtotal attribute to false as you create the fields. It all depends on what method you use to create your Pivot table. As below method does not work when you use the CreatePivotTable() method from a Pivot Cache that was Set using the Add method.
' Create the PivotTable object based on the Employee data on Sheet1.
Set objTable = Sheet1.PivotTableWizard
With objTable
'Specify row and column fields.
With .PivotFields("Supplier")
.Subtotals(1) = False
.Orientation = xlRowField
End With
With .PivotFields("Part #")
.Subtotals(1) = False
.Orientation = xlRowField
End With
With .PivotFields("Tracking #")
.Subtotals(1) = False
.Orientation = xlRowField
End With
With .PivotFields("Packing/Inv#")
.Subtotals(1) = False
.Orientation = xlRowField
End With
With .PivotFields("PO#")
.Subtotals(1) = False
.Orientation = xlRowField
End With
With .PivotFields("Ship Date")
.Subtotals(1) = False
.Orientation = xlRowField
End With
' Specify a data field with its summary
' function and format.
With .PivotFields("Qty")
.Subtotals(1) = False
.Orientation = xlDataField
.Function = xlSum
End With
End With