I am trying to loop though each worksheet in my workbook and reset all pivot data ranges to range("D1_Data") before refreshing.
Currently getting a Runtime error '1004' with the below code and somewhat stuck, any ideas?
Note that "TemplateWB" has been pre-set else where in my code as a workbook which the code is currently operating in.
'Set Dim
Dim PT As PivotTable
Dim WS As Worksheet
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
With PT.PivotCache
.SourceData = Range("D1_Data").Address(True, True, xlR1C1, True)
.Refresh
End With
Next PT
Next WS
Try the code below (I tested it on multiple Pivot Tables across different worksheets and it worked).
Option Explicit
Sub AutoRefreshPivot()
Dim WS As Worksheet
Dim PT As PivotTable
Dim PTCache As PivotCache
Dim NewLastRow As Long, NewLastColumn As Long
Dim TemplateWB As Workbook
' values for my internal testing
'Set TemplateWB = ThisWorkbook
'NewLastRow = 11
'NewLastColumn = 4
'Set D1_Data
TemplateWB.Sheets("Data_1").Range(Cells(1, 1), Cells(NewLastRow, NewLastColumn + 4)).Name = "D1_Data"
For Each WS In TemplateWB.Worksheets
For Each PT In WS.PivotTables
' set Pivot Cache to updated data source range (per each Pivot Table)
Set PTCache = TemplateWB.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Range("D1_Data").Address(True, True, xlR1C1, True), _
Version:=xlPivotTableVersion14)
With PT
.ChangePivotCache PTCache
' .Refresh
End With
' need to clear the cache every time after being used for a Pivot table
Set PTCache = Nothing
Next PT
Next WS
End Sub
Related
I am new to VBA and need to change the data source of the pivot to 'Sheet1'!$Q$4:$W$1940. The pivot table is present on sheet1 Y1.
Please help with a working code, I have been searching on google but no luck!
Thanks in advance!
Change Pivot Table Data Source
Option Explicit
Sub ChangeDataSource() '
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Sheet1")
Dim pCell As Range: Set pCell = ws.Range("Y3")
Dim ptbl As PivotTable: Set ptbl = pCell.PivotTable
ptbl.ChangePivotCache wb.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ws.Range("Q4:W1940"), Version:=7)
End Sub
I assume that since you are trying to set the range with code, you won't always know the # of rows.
But - you have to know something about the data to ensure it won't get errors. I am assuming that you know there will be data in cell Q4, and in your data set - there will always be a value in column Q.
Sub test()
Dim intLastRow As Integer, intLastColumn As Integer
intLastRow = Sheet1.Range("Q" & Application.Rows.Count).End(xlUp).Row
intLastColumn = Sheet1.Cells(4, Application.Columns.Count).End(xlToLeft).Column
If intLastRow <= 5 Then intLastRow = 5 'need to ensure there's a range to be slected
If intLastColumn <= Sheet1.Range("Q4").Column Then intLastColumn = Sheet1.Range("Q4").Column 'Ensure there's at least one column to select
Sheet1.PivotTables("pvtMyData").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase _
, SourceData:=Sheet1.Range(Sheet1.Range("Q4"), Sheet1.Cells(intLastRow, intLastColumn)) _
, Version:=8)
End Sub
** note - when you click in a pivot table and then click on the "Pivot Table Analyze" Ribbon, there is an option at the top-left to name your pivot table. In the example, I assume the name is "pvtMyData" - you can use the default name - e.g. "PivotTable5" but it might get confusing.
This will list all sources for all pivot tables in your entire workbook.
Sub PivotSourceListAll()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsList As Worksheet
Dim pt As PivotTable
Dim lPT As Long
Dim wsPT As Worksheet
Dim PTCount As Long
Dim strSD As String
On Error Resume Next
Set wb = ActiveWorkbook
For Each wsPT In wb.Sheets
If wsPT.PivotTables.Count Then
PTCount = PTCount + 1
End If
If PTCount > 0 Then Exit For
Next wsPT
If PTCount = 0 Then
MsgBox "No pivot tables in this workbook"
Exit Sub
End If
Set wsList = Worksheets.Add
With wsList
.Range(.Cells(1, 1), .Cells(1, 3)).Value _
= Array("Sheet", _
"PivotTable", "Source Data")
End With
lPT = 2
For Each ws In wb.Worksheets
For Each pt In ws.PivotTables
strSD = pt.SourceData
If strSD = "" Then strSD = "N/A"
With wsList
.Range(.Cells(lPT, 1), _
.Cells(lPT, 3)).Value _
= Array(ws.Name, pt.Name, strSD)
End With
lPT = lPT + 1
strSD = ""
Next pt
Next ws
With wsList
.Columns("A:C").EntireColumn.AutoFit
.Rows(1).Font.Bold = True
End With
End Sub
Get that working, and it should take much, then you should easily be able to change the source/range of your pivot table to a different source/range.
https://www.contextures.com/excelpivottabledatasource.html
I'm having toubles removing formulas from cells in Excel and keep only the value (in case there is a number). The problem is due to the fact that there are also pivot tables (and also GETPIVOTDATA cells) within the different spreadsheets.
I am currently trying this code but it only works on normal spreadsheets:
Sub fun()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim pc As PivotCell
For Each ws In ThisWorkbook.Worksheets
ws.Activate
With ws.UsedRange
.Value = .Value
End With
Next ws
For Each ws In ThisWorkbook.Worksheets
For Each pt In ws.PivotTables
For Each pf In pt.PivotFields
For Each pi In pf.PivotItems
pi.Value = pi.Value
Next pi
Next pf
Next pt
Next ws
End Sub
Could you help me to adapt the code so that every cell will be set to value?!
Option Explicit
Sub test1()
Dim ws As Worksheet, a, area As String
For Each ws In ThisWorkbook.Worksheets
a = ws.UsedRange
area = ws.UsedRange.Address
ws.Cells.ClearContents
ws.Range(area) = a
Next
End Sub
I am trying to copy Pivot table values into a new sheet using VBA. I am getting a runtime error 5. Here is my code
Sub test()
Dim shtTarget As Worksheet, pvtSht As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
Dim field As PivotField
Dim rngSource As Range
Dim wb As Workbook: Set wb = ThisWorkbook
With wb
Set rngSource = .Sheets(2).Range("A5").CurrentRegion
Set shtTarget = .Sheets.Add(After:=.Sheets(.Sheets.Count))
Set pc = .PivotCaches.Create(xlDatabase, rngSource.Address(False, False, xlA1, xlExternal))
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
End With
With pt.PivotFields("Concatenate")
.Orientation = xlRowField
.Position = 1
End With
pt.AddDataField pt.PivotFields("SCREEN_ENTRY_VALUE"), "Sum of SCREEN_ENTRY_VALUE", xlSum
With wb
Set pvtSht = .Sheets.Add(After:=.Sheets(.Sheets.Count))
pvtSht.Name = "Sum of Element Entries"
pt.TableRange2.Copy
pvtSht.Range("A1").PasteSpecial xlPasteValues
End With
End Sub
My pivot table is in a range of A5:I266. The code errors out on Set pt = pc.CreatePivotTable...
Replace:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3", , xlPivotTableVersion14)
with:
Set pt = pc.CreatePivotTable(shtTarget.Range("A1"), "PivotTable3")
My macro creates a pivot table from scratch from a set data dump. I am trying to move this macro to an add-in. the add-in works on the new data each time, but for some reason it pops up a second workbook that my code originally worked on.
I've read through add-in websites to make sure I set up the add-in correctly. My other add-in macro works (only have 2. still learning)
Sub OpenAndHoldPivot()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
'Determine the data range you want to pivot
Dim finRow As String
With ActiveWorkbook
finRow = ActiveSheet.Range("A200000").End(xlUp).Row
SrcData = ActiveSheet.Name & "!" & Range("A4:BO" & finRow - 1).Address (ReferenceStyle:=xlR1C1)
End With
'Create a new worksheet
Set sht = Sheets.Add
'Pivot Table Start
StartPvt = sht.Name & "!" & sht.Range("A3").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
'Create Pivot table from Pivot Cache
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")
'------------------------------------------------------------------------------
Set pvt = ActiveSheet.PivotTables("PivotTable1")
'Add item to the Report Filter
pvt.PivotFields("Future Fill Date").Orientation = xlPageField
'Add item to the Column Labels
pvt.PivotFields("Worker Type").Orientation = xlColumnField
'Add item to the Row Labels
pvt.PivotFields("Flex Division").Orientation = xlRowField
'Turn on Automatic updates/calculations --like screenupdating to speed up code
pvt.ManualUpdate = False
'------------------------------------------------------------------------------
ActiveSheet.Name = "Pivot"
'------------------------------------------------------------------------------
Dim pf As String
Dim pf_Name As String
pf = "FT/PT"
pf_Name = "Sum of FT/PT"
Set pvt = ActiveSheet.PivotTables("PivotTable1")
pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount
'------------------------------------------------------------------------------
Dim pm As PivotField
Set pm = ActiveSheet.PivotTables("PivotTable1").PivotFields("Future Fill Date")
'Clear Out Any Previous Filtering
pm.ClearAllFilters
'Filter on 2014 items
pm.CurrentPage = "(blank)"
'------------------------------------------------------------------------------
Sheets("Sheet1").Name = "Data"
End Sub
Any ideas on what I am doing wrong?
I really think your problem lies with some inconsistent refernces (or lack of refernces) to which workbook or worksheet you're using. Specifically, I believe the problem is with the line
Set sht = Sheets.Add
Since your Sheets reference doesn't specify which workbook to add the new worksheet, it will default to the currently active workbook which could be your add-in workbook. You'll help yourself a great deal if you become much clearer about which workbooks and worksheets you want. To illustrate this using your example, you can start with
Sub OpenAndHoldPivot()
Dim workingWB As Workbook
Dim workingWS As Worksheet
Set workingWB = ActiveWorkbook
Set workingWS = activeworksheet
'Determine the data range you want to pivot
Dim srcData As Range
Dim srcDataText As String
With workingWS
Dim finRow As Long
finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcData = .Range("A4").Resize(finRow - 1, 67)
srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
End With
This establishes clearly which workbook all your code will operate. Also, if you take a look at my With block and compare it to yours, you can see you missed a . before the Range reference, which again will likely refer back to either your add-in or the active workbook (and you can never be too sure.
After that, I just continue down the code...
'Create a new worksheet in the working workbook
Dim pivotWS As Worksheet
Set pivotWS = workingWB.Sheets.Add
'Pivot Table Start
Dim StartPvtText As String
StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Dim pvtCache As PivotCache
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=srcDataText)
'Create Pivot table from Pivot Cache
Dim pvt As PivotTable
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvtText, _
TableName:="PivotTable1")
Notice also that I declare all my variables as close to where they're used as possible. This makes it much easier to follow and to be certain you're using the correct variable with the intended type.
Further on down your code, you've referred to the ActiveSheet a few times. Replace that with a specific reference in order to be consistent. In my code, I rarely use ActiveSheet or ActiveCell. I attempted to fix the references below here in the full module, but only you can tell if this is accurate (because it's not perfectly clear which book or sheet you want).
Finally, there's the very last line of code Sheets("Sheet1").Name = "Data". I have no idea which workbook that should reference, but my guess is that it should be workingWB.Sheets("Sheet1").Name = "Data".
Option Explicit
Sub OpenAndHoldPivot()
Dim workingWB As Workbook
Dim workingWS As Worksheet
Set workingWB = ActiveWorkbook
Set workingWS = activeworksheet
'Determine the data range you want to pivot
Dim srcData As Range
Dim srcDataText As String
With workingWS
Dim finRow As Long
finRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcData = .Range("A4").Resize(finRow - 1, 67)
srcDataText = .Name & "!" & srcData.Address(ReferenceStyle:=xlR1C1)
End With
'Create a new worksheet in the working workbook
Dim pivotWS As Worksheet
Set pivotWS = workingWB.Sheets.Add
'Pivot Table Start
Dim StartPvtText As String
StartPvtText = pivotWS.Name & "!" & pivotWS.Range("A3").Address(ReferenceStyle:=xlR1C1)
'Create Pivot Cache from Source Data
Dim pvtCache As PivotCache
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=srcDataText)
'Create Pivot table from Pivot Cache
Dim pvt As PivotTable
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvtText, _
TableName:="PivotTable1")
'------------------------------------------------------------------------------
Set pvt = pivotWS.PivotTables("PivotTable1")
'Add item to the Report Filter
pvt.PivotFields("Future Fill Date").Orientation = xlPageField
'Add item to the Column Labels
pvt.PivotFields("Worker Type").Orientation = xlColumnField
'Add item to the Row Labels
pvt.PivotFields("Flex Division").Orientation = xlRowField
'Turn on Automatic updates/calculations --like screenupdating to speed up code
pvt.ManualUpdate = False
'------------------------------------------------------------------------------
pivotWS.Name = "Pivot"
'------------------------------------------------------------------------------
Dim pf As String
Dim pf_Name As String
pf = "FT/PT"
pf_Name = "Sum of FT/PT"
Set pvt = pivotWS.PivotTables("PivotTable1")
pvt.AddDataField pvt.PivotFields("FT/PT"), pf_Name, xlCount
'------------------------------------------------------------------------------
Dim pm As PivotField
Set pm = pivotWS.PivotTables("PivotTable1").PivotFields("Future Fill Date")
'Clear Out Any Previous Filtering
pm.ClearAllFilters
'Filter on 2014 items
pm.CurrentPage = "(blank)"
'------------------------------------------------------------------------------
workingWB.Sheets("Sheet1").Name = "Data"
End Sub
I'm trying to create a pivot table using VBA code. But it always show up the Run-time error '5'
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
SrcData = "Sheet1!" & Range("B2:M4").Address(ReferenceStyle:=xlA1)
StartPvt = "Sheet2!" & Range("A3").Address(ReferenceStyle:=xlA1)
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
Set pvt = pvtCache.CreatePivotTable(StartPvt, "PivotTable1")
What's wrong with this code?
The code below will Set pvt in case it's already created (from previous code runs), and just updates the PivotTable with the updated PivotCache.
If "PivotTable1" does not exist yet in "Sheet2", then creat it in "Sheet2".
Code
Option Explicit
Sub Pivot()
Dim PvtSht As Worksheet
Dim DataSht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Set DataSht = Worksheets("Sheet1")
Set PvtSht = Worksheets("Sheet2")
SrcData = "Sheet1!" & DataSht.Range("B2:M4").Address(ReferenceStyle:=xlA1)
' Set the Pivot Cache
Set pvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=SrcData)
' add this line in case the Pivot table doesn't exit >> first time running this Macro
On Error Resume Next
Set pvt = PvtSht.PivotTables("PivotTable1") ' check if "PivotTable1" Pivot Table already created (in past runs of this Macro)
On Error GoTo 0
If pvt Is Nothing Then
' create a new "PivotTable1" in "Sheet2" sheet
Set pvt = PvtSht.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=PvtSht.Range("A3"), TableName:="PivotTable1")
Else
' just refresh the Pivot cache with the updated Range
pvt.ChangePivotCache pvtCache
pvt.RefreshTable
End If
End Sub