Excel VBA - Generalize Pivot Source Data / Range - excel

I recorded the pivot table macro and I'm trying to generalize source data instead of going off of sheet name "REPORTS"
It grabs all the data from active sheet despite what the name of the sheet.
This way I can use the macro to create a pivot table for any active sheet:-
Sheets("**REPORTS**").Select
Range("A1").Select
Sheets.Add.Name = "Pivot"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Sheets("**REPORTS**").Range("A1").CurrentRegion, Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivot!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion15
Sheets("Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With

Sub TT()
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim pc As PivotCache
Set shtSrc = ActiveSheet
Set shtDest = shtSrc.Parent.Sheets.Add()
shtDest.Name = shtSrc.Name & "-Pivot"
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=shtSrc.Range("A1").CurrentRegion)
pc.CreatePivotTable TableDestination:=shtDest.Range("A3"), _
TableName:="PivotTable1"
With shtDest.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
End Sub

This will not add any data to the pivot table but it will create it
Sub Example()
Dim PrevSheet As Worksheet
Set PrevSheet = ActiveSheet
Range("A1").Select
Sheets.Add.Name = "Pivot"
PrevSheet.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveSheet.UsedRange, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivot!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15
Sheets("Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
End Sub

Related

create a repeatable pivot table that loads on the same worksheet

I try to take a table and create a pivot table adjacent to it.
This macro needs to work on separate worksheets so the table and pivot table names need to be generic and I am having a little trouble creating those names and I keep receiving errors.
Sub Macro1()
Dim rawtable As TableObject
Dim Number_of_producers_appointed As Sheet1
Dim Ptable As PivotTable
Dim tabledata As DataTable
Range("H1").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$H$697"), , xlYes).Name = _
"rawtable"
Range("rawtable").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"tabledata", Version:=6).CreatePivotTable TableDestination:= _
Number_of_producers_appointed & "!R6C10", TableName:="Ptable", _
DefaultVersion:=6
Sheets("Number of producers appointed").Select
Cells(6, 10).Select
With ActiveSheet.PivotTables("Ptable").PivotFields("Producer Type")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("Ptable").PivotFields("Producer Type")
.Orientation = xlRowField
.Position = 1
End With
ActiveSheet.PivotTables("Ptable").AddDataField ActiveSheet.PivotTables( _
"Ptable").PivotFields("EPN"), "Count of EPN", xlCount
End Sub
The error I am receiving is
Error 91; object variable or With block variable not set
on:
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"tabledata", Version:=6).CreatePivotTable TableDestination:= _
Number_of_producers_appointed & "!R6C10", TableName:="Ptable", _
DefaultVersion:=6
I suggest to build everything object-by-object like this:
Sub GenerateNewPivottable()
Dim wsProducer As Worksheet
Dim objRawData As ListObject
Dim lastUsedRow As Long
Dim objPivotCache As PivotCache
Dim objPivotTable As PivotTable
' define a variable for your worksheet
Set wsProducer = ActiveWorkbook.Worksheets("Number of producers appointed")
' get the last used row in its column A
lastUsedRow = wsProducer.Cells(wsProducer.Rows.Count, "A").End(xlUp).Row
' If you want to convert an existing listobject ("table") to a range before:
'For Each objRawData In wsProducer.ListObjects
' objRawData.Unlist
'Next objRawData
' convert the used range of the worksheet to a new listobject
Set objRawData = wsProducer.ListObjects.Add( _
SourceType:=xlSrcRange, _
Source:=wsProducer.Range("A1:H" & lastUsedRow), _
XlListObjectHasHeaders:=xlYes)
' Give the listobject a name (not necessary if default name is okay)
'objRawData.Name = "rawtable"
' use listobject for a new pivotcache
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=objRawData)
' delete existing pivottables on this sheet if necessary
'For Each objPivotTable In wsProducer.PivotTables
' objPivotTable.TableRange2.Clear
'Next objPivotTable
' generate a new pivottable with above pivotcache
Set objPivotTable = objPivotCache.CreatePivotTable( _
TableDestination:=wsProducer.Cells(6, 10))
' Give the pivot table a name, not necessary if default is okay
'objPivotTable.Name = "Ptable"
' Define its row fields, column fields and data fields:
With objPivotTable.PivotFields("Producer Type")
.Orientation = xlRowField
.Position = 1
End With
With objPivotTable.PivotFields("EPN")
.Orientation = xlDataField
.Function = xlCount
.Name = "Count of EPN"
End With
End Sub
You may address a worksheet by its name or its index:
Set wsProducer = ActiveWorkbook.Worksheets("Number of producers appointed")
Set wsProducer = ActiveWorkbook.Worksheets(5)

How to apply For Loop to create Multiple PIVOT Tables using VBA

I want to create 14 pivot table.I have recorded a macro.My macro code is given below.If I want to apply for loop to create 14 pivot tables, how to do that?
I am a beginner so unable to understand how to apply for loop to automate this recorded code?
My macro is given below:
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlDown)).Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Current Fleet Comparison!R1C1:R1048576C41", Version:=xlPivotTableVersion14). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion14
Sheets("Sheet1").Select
Cells(3, 1).Select
ActiveWorkbook.ShowPivotTableFieldList = True
With ActiveSheet.PivotTables("PivotTable1").PivotFields("AircraftType")
.Orientation = xlPageField
.Position = 1
End With
ActiveSheet.PivotTables("PivotTable1").AddDataField ActiveSheet.PivotTables( _
"PivotTable1").PivotFields("AircraftType"), "Count of AircraftType", xlCount
With ActiveSheet.PivotTables("PivotTable1").PivotFields("OperatorArea")
.Orientation = xlColumnField
.Position = 1
End With
Range("A1:F5").Select
Selection.Copy
Range("A8").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable2").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable2").PivotFields("AircraftType").CurrentPage _
= "A318"
Range("A15").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable3").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable3").PivotFields("AircraftType").CurrentPage _
= "A319"
Range("A22").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable4").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("AircraftType").CurrentPage _
= "A320"
ActiveWindow.SmallScroll Down:=15
Range("A29").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable5").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable5").PivotFields("AircraftType").CurrentPage _
= "A321"
Range("A36").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable6").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable6").PivotFields("AircraftType").CurrentPage _
= "ATR 42"
ActiveWindow.SmallScroll Down:=3
Range("A43").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable7").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable7").PivotFields("AircraftType").CurrentPage _
= "ATR 72"
ActiveWindow.SmallScroll Down:=9
Range("A50").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable8").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable8").PivotFields("AircraftType").CurrentPage _
= "CRJ100 Regional Jet"
ActiveWindow.SmallScroll Down:=3
Range("A57").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable9").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable9").PivotFields("AircraftType").CurrentPage _
= "CRJ200 Regional Jet"
ActiveWindow.SmallScroll Down:=12
Range("A65").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable10").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable10").PivotFields("AircraftType"). _
CurrentPage = "Q100"
Range("A72").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable11").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable11").PivotFields("AircraftType"). _
CurrentPage = "Q200"
ActiveWindow.SmallScroll Down:=9
Range("A79").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable12").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable12").PivotFields("AircraftType"). _
CurrentPage = "Q300"
ActiveWindow.SmallScroll Down:=9
Range("A86").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable13").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable13").PivotFields("AircraftType"). _
CurrentPage = "Q400"
ActiveWindow.SmallScroll Down:=9
Range("A94").Select
ActiveSheet.Paste
ActiveSheet.PivotTables("PivotTable14").PivotFields("AircraftType"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable14").PivotFields("AircraftType"). _
CurrentPage = "Q400 NextGen"
End Sub
I am a beginner so unable to understand how to apply for loop to automate this recorded code?
In the following macro, since your sample code didn't contain all 14 pages to be used for the pagefield, you'll need to complete the list being assigned to varPages before running the macro...
'Force the explicit declaration of variables
Option Explicit
Sub CreatePivotTables()
'Declare the variables
Dim varPages As Variant
Dim objPivotCache As PivotCache
Dim objPivotTable As PivotTable
Dim wksSource As Worksheet
Dim rngSource As Range
Dim CurrRow As Long
Dim i As Long
'Turn off screen updating to speed up macro
Application.ScreenUpdating = False
'Assign the source worksheet for the pivottables to wksSource
Set wksSource = Worksheets("Current Fleet Comparison")
'Assign the source range for the pivottables to rngSource
Set rngSource = wksSource.Range("A1").CurrentRegion
'Create the pivotcache for the pivottables
Set objPivotCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=rngSource)
'Add new worksheet for the pivottables
Sheets.Add
'Assign the list of pages for the pagefield to varPages (add the remaining pages)
varPages = Array("A318", "A319", "A320", . . .)
CurrRow = 3
For i = 1 To 14
'Create the pivottable
Set objPivotTable = ActiveSheet.PivotTables.Add( _
PivotCache:=objPivotCache, _
TableDestination:=Cells(CurrRow, "A"), _
TableName:="PivotTable" & i)
'Add the fields for the pivottable
With objPivotTable
.AddDataField .PivotFields("AircraftType"), "Count of AircraftType", xlCount
.PivotFields("OperatorArea").Orientation = xlColumnField
With .PivotFields("AircraftType")
.Orientation = xlPageField
.CurrentPage = varPages(i - 1)
End With
With .TableRange2
CurrRow = .Offset(.Rows.Count + 4).Row
End With
End With
Next i
'Show the pivottable field list
ActiveWorkbook.ShowPivotTableFieldList = True
'Turn screen updating back on
Application.ScreenUpdating = True
End Sub

Copy data from multiple sheets into multiple sheets in new workbook

I know variations of this question have been asked but I can't seem to find the right code to accomplish this task. I have 2 tabs, Master Summary and Master Detail, from which I would like to copy data based on cell values in columns K and G respectively. I would like to copy data from both tabs into a new workbook if the values where these columns match. Each value needs its own workbook to be saved as the name in the cell.
Thanks
Here is what I came up with:
Sub CopyCMOsToOwnWorkbooks()
Application.EnableCancelKey = xlDisabled
Application.ScreenUpdating = False
Dim CMO As Variant
Dim CMOS As Variant
Dim wbDest As Workbook
Dim RAF As Workbook
Set RAF = ThisWorkbook
Dim rng As Range
Set rng = Range(Range("A1"), Range("A1").SpecialCells(xlLastCell))
CMOS = Array("Element Care", "CCACG EAST", "SCMO", "CCACG WEST", "Uphams Corner Hlth Cent", "CCC-Boston", "Vinfen", "Behavioral Hlth Ntwrk", _
"CommH Link Worc", "Long Term Care CMO", "Advocates, Inc", "CCC-Springfield", "BU Geriatric Service", "Lynn Comm HC", "CCA-BHI", "BIDJP Subacute", _
"CCC-Lawrence", "CCC-Framingham", "East Boston Neighborhoo", "BosHC 4 Homeless", "Bay Cove Hmn Srvces", "Mailhoit, Carrie", "Brightwood Hlth Ctr-Bay", _
"Romero, Michele", "Isaacs, Cindy", "McCoy, Viola", "ADRC of Greater North Shore", "Geller, Marian")
For Each CMO In CMOS
On Error Resume Next
RAF.Activate
Application.CutCopyMode = False
Sheets("MASTER Summary").Select
Range("F12").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table_Query_from_ProdServerP052").Range.AutoFilter _
Field:=11, Criteria1:=CMO
Cells.Select
Selection.Copy
Set wbDest = Workbooks.Add(xlWBATWorksheet)
ActiveSheet.Paste
ActiveSheet.Cells.Select
Selection.ColumnWidth = 8.29
Cells.EntireColumn.AutoFit
Selection.ColumnWidth = 78.71
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Summary"
Range("C24").Select
ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = _
"Table1"
Range("Table1[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight13"
RAF.Activate
Application.CutCopyMode = False
Sheets("MASTER Detail").Select
Range("A2").Select
Selection.AutoFilter
ActiveSheet.ListObjects("Table_Query_from_ProdServerP054").Range.AutoFilter _
Field:=7, Criteria1:=CMO
Cells.Select
Selection.Copy
wbDest.Activate
Sheets.Add After:=ActiveSheet
Range("A1").Select
ActiveSheet.Paste
Cells.Select
Selection.ColumnWidth = 34.29
Selection.ColumnWidth = 50.71
Cells.EntireRow.AutoFit
Cells.EntireColumn.AutoFit
wbDest.Sheets("Sheet2").Select
wbDest.Sheets("Sheet2").Name = "Detail"
ActiveSheet.ListObjects.Add(xlSrcRange, rng, , xlYes).Name = _
"Table2"
Range("Table2[#All]").Select
ActiveSheet.ListObjects("Table1").TableStyle = "TableStyleLight13"
Range("A13").Select
wbDest.Sheets("Summary").Select
Application.DisplayAlerts = False
wbDest.SaveAs ThisWorkbook.Path & Application.PathSeparator & _
CMO & " " & Format(Date, "mmm_dd_yyyy")
Application.DisplayAlerts = True
wbDest.Close
Next CMO
End Sub

Macros record - pivot chart not working

I tried to record macros of creating a pivot chart. When I run the recorde33d macros after deleting the old chart, an error is being generated. "invalid procedure call or argument'
The error highlights the first line. Can pivot charts be done by macros? Or it just doesn't work when macros recorded?
Sub Macro5()
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Warranty!R1C1:R1048576C52", Version:=xlPivotTableVersion15). _
CreatePivotTable TableDestination:="Customer Pareto!R12C6", TableName:= _
"PivotTable4", DefaultVersion:=xlPivotTableVersion15
Sheets("Customer Pareto").Select
ActiveSheet.Shapes.AddChart2(201, xlColumnClustered).Select
ActiveChart.SetSourceData Source:=Range("'Customer Pareto'!$F$12:$H$29")
ActiveChart.PivotLayout.PivotTable.AddDataField ActiveChart.PivotLayout. _
PivotTable.PivotFields("VEH_IDENT_NBR"), "Count of VEH_IDENT_NBR", xlCount
With ActiveChart.PivotLayout.PivotTable.PivotFields("Step")
.Orientation = xlColumnField
.Position = 1
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("SA Status")
.Orientation = xlColumnField
.Position = 2
End With
With ActiveChart.PivotLayout.PivotTable.PivotFields("SA_Failure_Mode")
.Orientation = xlRowField
.Position = 1
End With
ActiveChart.ChartType = xlBarStacked
With ActiveSheet.PivotTables("PivotTable4").PivotFields("SA_Failure_Mode")
.PivotItems("").Visible = False
.PivotItems("(blank)").Visible = False
End With
ActiveSheet.ChartObjects("Chart 6").Activate
ActiveSheet.Shapes("Chart 6").IncrementLeft 102
ActiveSheet.Shapes("Chart 6").IncrementTop -87
With ActiveSheet.PivotTables("PivotTable4").PivotFields("Step")
.PivotItems("").Visible = False
.PivotItems("(blank)").Visible = False
End With
Range("G13").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Step").PivotItems( _
"Implementation").ShowDetail = False
Range("H13").Select
ActiveSheet.PivotTables("PivotTable4").PivotFields("Step").PivotItems( _
"Solution").ShowDetail = False
ActiveSheet.ChartObjects("Chart 6").Activate
End Sub
Modify and use this as per your requirement:
Key things:
1.TableDestination = should be a range with no pivot table.
2.Change: TableDestination = Sheet Name instead of demo and DefaultVersion = xlPivotTableVersion15 instead of 10
3.Before calling the below Sub, activesheet should be the sheet containing sourceData
Sub Make_PivotTable()
Debug.Print ActiveWorkbook.PivotCaches.Count
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
ActiveSheet.UsedRange).CreatePivotTable TableDestination:="demo!R1C1", TableName:= _
"PivotTable1", DefaultVersion:=xlPivotTableVersion10
Sheets("demo").PivotTables("PivotTable1").AddFields RowFields:="Name"
Sheets("demo").PivotTables("PivotTable1").PivotFields("Age").Orientation = _
xlDataField
Debug.Print ActiveWorkbook.PivotCaches.Count
End Sub
' You can see MS KB link for office 2007 to get informed about your error.
'If this helps Mark as Answer and/upvote, otherwise comment what happened after implementation.
The issue is with spaces in destination file name. The workaround that I have developed is as follows:
Dim wsNew As Worksheet
Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count))
wsNew.Name = "Your Sheet Name with Spaces"
Sheets("Where my table sits as source data").Select
Range("A2").Activate
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"MyTableName", Version:=6).CreatePivotTable TableDestination:= _
"'" & wsNew.Name & "'!R3C2", TableName:="MyNewPivotName", DefaultVersion:=6
Sheets("DestinationSheet").Select

Run time error 1004 for pivot table creation

I am trying to create a pivot table from a .csv file. But I am having a run time error 1004: Reference is not valid over at the ActiveWorkbook portion of the code.
Any suggestions for this?
My code is as follows
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
Sheets.Add
ws.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ws.Name & "R1C1:R101643C21", Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
I did a Sheets.Add to add in new worksheet. I used a ws.Name as the name can be any name. Just an addition question, is it possible to change R1C1:R101643C21 to a varying range as the data may not be that big or small?
Notice the ! in SourceData. The missing ! is causing the invalid reference
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ws.Name & "!R1C1:R11C2", Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
For dynamic range, see this
Sub test()
Dim ws As Worksheet
Dim rng As Range
Set ws = ActiveSheet
Set rng = ws.Range("A1:B10")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rng, Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
Just a reminder, you are only creating a empty pivot table in this way

Resources