This is the layout I want: but this is what currently I get:
from this code:
Private Sub KPIDashboardTable()
Sheets("KPI Dashboard List").Activate
Dim objTable As PivotTable, objField As PivotField, Ws As Worksheet
ActiveWorkbook.Sheets("KPI Dashboard List").Range("A1").Select
Set Ws = Sheets.Add
Ws.Name = "KPI Dashboard List Table"
Set objTable = Sheets("KPI Dashboard List").PivotTableWizard(TableDestination:=Ws.Cells(3, "A"))
objTable.PivotCache.MissingItemsLimit = xlmissingItemNone
objTable.PivotCache.Refresh
Set objField = objTable.PivotFields("DATE OPENED")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("KPI")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.Position = 1
Set objField = objTable.PivotFields("KPI")
objField.Orientation = xlDataField
Dim pf As PivotField
Set pf = ActiveSheet.PivotTables(1).PivotFields("DATE OPENED")
pf.DataRange.Cells(1).Group Start:=True, End:=True, Periods:=Array(False, False, _
False, False, True, False, False)
Range("B2").Value = "KPI Dashboard"
Range("A2:O2").Font.Bold = True
Range("A2:O2").Interior.Color = vbYellow
End Sub
How can I change the orientation of the PivotTable?
You need to add:
With objTable.DataPivotField
.Orientation = xlColumnField
.Position = 1
End With
Related
I have a sheet with 1532 rows and 7 columns called "Delayed Students". I want to make a pivot table in the sheet but every time I use my code, I get a
run-time error'438 "Object doesn't support this property or method"
And this area is yellow (.Position =1):
With .PivotFields("FACULTY_ID")
.Orientation = xlDataField
.Postion = 1
But it creates the pivot table anyways. The problem is when i delete the table and try to use the code again it doesn't create the pivot table again. So something must be wrong with my code:
Sub Pivot1()
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim PvtTblName As String
Dim pivotTableWs As Worksheet
PvtTblName = "pivotTableName"
Set pivotTableWs = Sheets("Delayed Students")
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:="Delayed Students!R1C1:R1532C7")
Set PvtTbl = pivotTableWs.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=pivotTableWs.Range("J1"), TableName:=PvtTblName)
With PvtTbl
.ColumnGrand = True
.HasAutoFormat = True
.DisplayErrorString = False
.DisplayNullString = True
.EnableDrilldown = True
.ErrorString = ""
.MergeLabels = False
.NullString = ""
.PageFieldOrder = 2
.PageFieldWrapCount = 0
.PreserveFormatting = True
.RowGrand = True
.SaveData = True
.PrintTitles = False
.RepeatItemsOnEachPrintedPage = True
.TotalsAnnotation = False
.CompactRowIndent = 1
.InGridDropZones = False
.DisplayFieldCaptions = True
.DisplayMemberPropertyTooltips = False
.DisplayContextTooltips = True
.ShowDrillIndicators = True
.PrintDrillIndicators = False
.AllowMultipleFilters = False
.SortUsingCustomLists = True
.FieldListSortAscending = False
.ShowValuesRow = False
.CalculatedMembersInFilters = False
.RowAxisLayout xlCompactRow
With .PivotCache
.RefreshOnFileOpen = False
.MissingItemsLimit = xlMissingItemsDefault
End With
.RepeatAllLabels xlRepeatLabels
With .PivotFields("STUDYBOARD_ID")
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields("FACULTY_ID")
.Orientation = xlDataField
.Postion = 1
End With
End With
End Sub
Hope someone can help me with what i am doing wrong :)
I have a macro ("List_of_sheets") that creates a list of all the sheets in the workbook, and places the list in the "Sheetlist"-sheet underneath the "Header"-word.
The macro deletes the previous list and creates a new list, whenever I run the macro. I do this manually whenever I delete, add, copy or change the name of sheet. However, I want this to run automatically.
Thanks in advance!
Sub List_of_sheets()
Dim objSheet As Worksheet
Dim intRow As Integer
Dim strCol As Integer
Dim GCell As Range
SearchText = "Header"
Set GCell = Worksheets("Listsheet").Cells.Find(SearchText).Offset(2, -1)
GCell.End(xlDown).ClearContents
intRow = GCell.Row
strCol = GCell.Column
For Each objSheet In ActiveWorkbook.Sheets
ActiveWorkbook.Worksheets("Listsheet").Hyperlinks.Add Anchor:=ActiveWorkbook.Worksheets("Listsheet").Cells(intRow, strCol), Address:="", SubAddress:= _
"'" & objSheet.Name & "'!A1", TextToDisplay:=objSheet.Name
With ActiveWorkbook.Worksheets("Listsheet").Cells(intRow, strCol).Font
.Name = "Calibri"
.FontStyle = "Normal"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
intRow = intRow + 1
Next objSheet
End Sub
you have to go with Workbooks events, although they don't cover the case of a sheet name change
but as a workaround you could use Workbook_SheetActivate since when you change the name of a sheet and then you want to see if the list has been updated you have to activate the list sheet
so place in ThisWorkbook code pane the following:
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Application.EnableEvents = False
List_of_sheets
Application.EnableEvents = True
End Sub
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Application.EnableEvents = False
List_of_sheets
Application.EnableEvents = True
End Sub
and you could consider the following refactoring of your code
Option Explicit
Sub List_of_sheets()
Dim objSheet As Worksheet
Dim intRow As Integer
Dim strCol As Integer
Dim GCell As Range
Dim SearchText As String
SearchText = "Header"
Set GCell = Worksheets("Listsheet").UsedRange.Find(what:=SearchText, lookat:=xlWhole, LookIn:=xlValues).Offset(2, -1)
GCell.End(xlDown).ClearContents
intRow = GCell.Row
strCol = GCell.Column
Dim listSheet As Worksheet
With ActiveWorkbook
Set listSheet = .Worksheets("Listsheet")
For Each objSheet In .Sheets
listSheet.Hyperlinks.Add Anchor:=listSheet.Cells(intRow, strCol), Address:="", SubAddress:= _
"'" & objSheet.Name & "'!A1", TextToDisplay:=objSheet.Name
intRow = intRow + 1
Next objSheet
End With
With listSheet.Cells(GCell.Row, strCol).Resize(Sheets.Count).Font
.Name = "Calibri"
.FontStyle = "Normal"
.Size = 11
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End Sub
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 have been using a vba code to create pivot tables and remove grand & sub-totals for a couple of weeks now. The subtotal part of the code which was previously working well is not throwing the following error
Run-Time Error '1004': Unable to set the Subtotals property of the PivotField Class
and i an not to figure whats causing it.
Below is the code, Appreciate any help.
Regards
Sub Pivottable_5()
Dim objTable As PivotTable
Dim objField As PivotField
' Select the sheet and first cell of the table that contains the data.
ActiveWorkbook.Sheets("All Proj").Select
Range("A1").Select
' Create the PivotTable object based on the Employee data on Sheet1.
Set objTable = ActiveSheet.PivotTableWizard
' Specify row and column fields.
Set objField = objTable.PivotFields("Products")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Product")
objField.Orientation = xlRowField
Set objField = objTable.PivotFields("Value Category")
objField.Orientation = xlRowField
objField.PivotItems("(blank)").Visible = False
Set objField = objTable.PivotFields("Driven?")
objField.Orientation = xlPageField
objField.PivotItems("No").Visible = False
objField.PivotItems("(blank)").Visible = False
objField.PivotItems("Not Classified").Visible = False
Set objField = objTable.PivotFields("Project Status")
objField.Orientation = xlPageField
objField.PivotItems("Cancelled").Visible = False
objField.PivotItems("Suspended").Visible = False
objField.PivotItems("Scoped not active").Visible = False
objField.PivotItems("(blank)").Visible = False
Set objField = objTable.PivotFields("SPA Business Unit")
objField.Orientation = xlPageField
objField.PivotItems("-").Visible = False
objField.PivotItems("Not Classified").Visible = False
objField.PivotItems("Plth").Visible = False
objField.PivotItems("(blank)").Visible = False
' Specify a data field with its summary
' function and format.
Set objField = objTable.PivotFields("2014 Actual Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2015 Actual Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2016 Actual Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2016 Forecast Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2017 Forecast Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2018 Forecast Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
Set objField = objTable.PivotFields("2019 Forecast Total")
objField.Orientation = xlDataField
objField.Function = xlSum
objField.NumberFormat = "$ #,##0"
ActiveSheet.name = "iNexus Pivot"
' Rename the pivot table
With Sheets("iNexus Pivot")
.PivotTables(1).name = "PivotTable2"
End With
With Sheets("iNexus Pivot").PivotTables("PivotTable2").DataPivotField
.Orientation = xlColumnField
End With
ActiveSheet.PivotTables("PivotTable2").ColumnGrand = False
ActiveSheet.PivotTables("PivotTable2").RowGrand = False
Dim i As Integer
Dim iFieldMax As Integer
'Find the number of PivotFields
iFieldMax = ActiveSheet.PivotTables("PivotTable2").PivotFields.Count
'Loop through the fields in the Pivot
For i = 1 To iFieldMax
With ActiveSheet.PivotTables("PivotTable2").PivotFields(i)
'Set subtotal calculation to nothing
.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
End With
Next i
ActiveSheet.PivotTables("PivotTable2").RowAxisLayout xlTabularRow
ActiveWindow.Zoom = 80
ActiveSheet.Cells.EntireColumn.AutoFit
ActiveSheet.Cells(ActiveCell.Row, 1).Select
' Move the cursor to the sheet with the buttons
Application.Goto Reference:="Sheet1!R1C1"
ActiveWorkbook.Save
End Sub
I have been facing similar problem. The issue is Office 365 update. After update, code does not work. Had to roll back. There is nice page for that:
https://www.cnet.com/how-to/how-to-revert-to-the-previous-version-of-office-365/
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