VBA Macro - Pivot Table CurrenRegion - vba

I am keep getting an error message
Run-time Error 1004: Unable to get the CurrentRegion Property of the
Range Class.
I am trying to create a dynamic Source Data, since the source is changing.
Dim pc As PivotCache
Dim pt As PivotTable
Set pc = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=Sheet1.Name & "!" & Sheet1.Range("A1").CurrentRegion.Address, _
Version:=xlPivotTableVersion14)
Worksheets.Add
Range("A3").Select
Set pt = pc.CreatePivotTable( _
TableDestination:=ActiveCell, _
TableName:="NetZero")

You don't need a macro for this. Just convert your source data to Table. Use "Format as Table" button on Home menu. and then your source data will always be dynamic.

If you wish to keep using the concept of using a dynamic range that grows (not a table), then use the code below:
Dim pc As PivotCache
Dim pt As PivotTable
Set pc = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Sheet1.Range("A1").CurrentRegion.Address(False, False, xlA1, xlExternal))
Worksheets.Add
' there's no need to select the Range, you can set the Table destination to "A3"
Set pt = pc.CreatePivotTable(TableDestination:=Range("A3"), TableName:="NetZero")

I don't know the exact reason but I was having the same problem. You can try selecting the cells in excel sheet. If you are able to select the cell then your CurrentRegion property will work. If not then your cells are locked. You reopen your excel sheet and try running the macro.

Related

Macro crashes while creating pivot out of large data sets

I am quite new to VBA and excel macros but want to automate certain reports for work and I am really hoping for someone's help. I tried to fix it myself by watching YouTube videos and reading stackoverflow but the solution didn't match with my issue. For now I created few macros but i am stuck with the one which should actually create a pivot table.
I first created a regular table out of the data I had (using TableP Macro beloew). It looks like it works fine (tested few other data sheets) :
Sub tableP()
'
' tableP Macro (Creates a table of the existing data sheet, regardless the data input)
'
ActiveCell.Cells.Select
ActiveCell.Activate
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$1:$1048576"), , xlYes).Name = _
"Table2"
ActiveCell.Cells.Select `
`End Sub `
The second macro (below) would ideally take that table (an object) and create a pivot table, however it crashes (excel stops working while I run the macro) each time I use a bigger dataset.
Sub Macro1test() '
' Macro1test creates dataset out of the existing table
'
Dim dataname As String
Dim Newsheet As String
dataname = ActiveSheet.ListObjects(1).Name
Sheets.Add
Newsheet = ActiveSheet.Name
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
dataname, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination _
:=Newsheet & "!R3C1", TableName:="PivotTable2", DefaultVersion:= _
xlPivotTableVersion14
Sheets.Select
Cells(3, 1).Select
End Sub
Can please someone let me know what am I doing wrong and what steps am missing to be able to apply those macros on any data set?
Try the code below, explanations inside the code's comments:
Option Explicit
Sub Macro1test()
' Macro1test creates dataset out of the existing table
'
Dim dataname As String
Dim RngStr As String
Dim Newsheet As String
Dim NewSht As Worksheet
Dim PvtCache As PivotCache
Dim PvtTbl As PivotTable
' set the Range String for the Pivot Cache Source Data)
RngStr = ActiveSheet.ListObjects(1).Range.Address(False, False, xlA1, xlExternal)
' add a new sheet
Set NewSht = ThisWorkbook.Sheets.Add(after:=ActiveSheet)
' set the Pivot Cache object
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=RngStr)
' set the New Pivot Table object
Set PvtTbl = NewSht.PivotTables.Add(PivotCache:=PvtCache, TableDestination:=NewSht.Range("A3"), TableName:="PivotTable2")
End Sub

Run-Time Error 1004 - Macro to update pivot table

I am trying to update a pivot table using a macro since data is added to the bottom of the table each month (Update to include data to last row).
Option Explicit
Sub Pivot()
Dim shConD As Worksheet
Dim shPvtTbl As Worksheet
Dim lr As Long
Dim rng As Range
Set shConD = ActiveWorkbook.Sheets("Consolidated_Data")
Set shPvtTbl = ActiveWorkbook.Sheets("PivotTables")
lr = shConD.Range("A" & Rows.Count).End(xlUp).Row
Set rng = shConD.Range("A1:F" & lr)
With shPvtTbl.PivotTables(3).PivotCache
.SourceData = rng.Address(True, True, xlR1C1, True) 'Error appears here
.Refresh
End With
End Sub
On the .SourceData line, I am getting run-time error 1004, Application-defined or object-defined error. Followed logic from this thread and the continued chat . Thanks in advance guys.
If you're using Excel 2007 or later, then the simplest way to accomplish this is to make sure your PivotTable source data is an Excel Table (aka ListObject), and use the Table name in the Change PivotTable Data Source as shown below.
Thanks to the magic of Tables, from that point on, whenever you add new data to your Table, it will expand automatically. And whenever you refresh the PivotTable it will always pick up that new data automatically. There will be no need to change the PivotTable data source ever again.
Try the code below (explanation inside the code's comments) :
Option Explicit
Sub Pivot()
Dim shConD As Worksheet
Dim shPvtTbl As Worksheet
Dim lr As Long
Dim rng As Range
' Added PivotTable variables
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Set shConD = ActiveWorkbook.Sheets("Consolidated_Data")
Set shPvtTbl = ActiveWorkbook.Sheets("PivotTables")
lr = shConD.Range("A" & shConD.Rows.Count).End(xlUp).Row
Set rng = shConD.Range("A1:F" & lr)
' set/update the PivotCache (with latest rng modifications
Set PvtCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rng.Address(False, False, xlA1, xlExternal))
' for DEBUG Only
Debug.Print PvtCache.SourceData
' set the PivotTable object
Set PvtTbl = shPvtTbl.PivotTables(3)
' for DEBUG Only
Debug.Print PvtTbl.Name
' refresh the PivotTable with the updated PivotCache
PvtTbl.ChangePivotCache PvtCache
PvtTbl.RefreshTable
End Sub

Run time error 1004 "Cannot open PivotTable source file"

I want to create a pivot table based on a dataset (contained in a worksheet) in the same workbook.
The workbook is open when I run the macro. The dataset comes from running a query in Access, and then export it to excel. I also tried to save the workbook prior to running the macro. I am using excel 2016.
This is my code:
Sub BusinessInteligenceCreatePivotTable()
Dim PivotSheet As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
'Determine the data range you want to pivot
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsPartsMachines.Name & "'!" & wsPartsMachines.Range("A1").CurrentRegion.Address, Version:=xlPivotTableVersion15)
'Create a new worksheet
With ThisWorkbook
Set PivotSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
PivotSheet.Name = "Production Schedule"
End With
PivotSheet.Activate
Range("A1").Select
'Create Pivot table from Pivot Cache
'Set pvt = pvtCache.CreatePivotTable(TableDestination:=ActiveCell, TableName:="ProductionSchedule")
Set pvt = PivotSheet.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=ActiveCell, TableName:="ProdSched")
End Sub
The two last lines generates the same error message. "Run time error 1004. Cant open PivotTable source file 'C:\Users...'".
Does anybody know how to solve this problem?
Thanks.
EDIT
When I record a macro, VBA gives me this code (it works).
Sub BusinessInteligenceCreatePivotTable()
Dim PivotSheet As Worksheet
With ThisWorkbook
Set PivotSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
PivotSheet.Name = "Production Schedule"
End With
PivotSheet.Activate
Range("A1").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Parts & Machines2!R1C1:R1328C14", Version:=6).CreatePivotTable _
TableDestination:=ActiveCell, TableName:="PivotTable1", DefaultVersion:=6
End Sub
I want my SourceData's range to be dynamically set. My efforts to do it generates (with debug.print): 'Parts & Machines2'!R1C1:R1328C14
It seems to be different from the macro-recorded :"Parts & Machines2!R1C1:R1328C14".
Is it this difference that generates the error that i cant find the source data?
Screenshot of Data.
I am not so sure where you define wsPartsMachines as Worksheet and where you set it.
However, the error is in the line:
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsPartsMachines.Name & "'!" & wsPartsMachines.Range("A1").CurrentRegion.Address, Version:=xlPivotTableVersion15)
If you add a line after:
Debug.Print pvtCache.SourceData
You will get 'Sheet3'''!R1C1:R6C3 in the immediate window - you have one ' too many. (I have used "Sheet3" as my SourceData)
Try to modify this line to :
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=wsPartsMachines.Name & "!" & wsPartsMachines.Range("A1").CurrentRegion.Address)
Edit 1: Try a different approach, bring the data source direclty as Range:
Dim pvtDataRng As Range
Set wsPartsMachines = Sheets("Parts & Machines2")
' set the Pivot Table Data Source Range
Set pvtDataRng = wsPartsMachines.Range("A1").CurrentRegion
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pvtDataRng)
'Create Pivot table from Pivot Cache
Set pvt = PivotSheet.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=ActiveCell, TableName:="ProdSched")
This code works. Still not sure why SourceData does not work. With small changes in the code that Shai Rado suggested it worked. Below is the code.
Sub BusinessInteligenceCreatePivotTable()
Dim PivotSheet As Worksheet
Dim pvtCache As PivotCache
Dim pvtTable As PivotTable
Dim ws1PartMachines As Worksheet
Dim pvtDataRng As Range
'Determine the data range you want to pivot
Set ws1PartsMachines = Worksheets("Parts & Machines2")
' set the Pivot Table Data Source Range
Set pvtDataRng = ws1PartsMachines.Range("A1").CurrentRegion
Set pvtCache = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=pvtDataRng)
Debug.Print pvtCache.SourceData
'Create a new worksheet
With ThisWorkbook
Set PivotSheet = .Sheets.Add(After:=.Sheets(.Sheets.Count))
PivotSheet.Name = "Production Schedule2"
End With
PivotSheet.Activate
Range("A1").Select
'Create Pivot table from Pivot Cache
Set pvtTable = PivotSheet.PivotTables.Add(PivotCache:=pvtCache, TableDestination:=ActiveCell, TableName:="ProdSched")
End Sub

Bug found while replacing text in formulas

I discovered a very interesting bug today i.e if it is a bug.
Can you please confirm if you can replicate it? If it is a bug and has been not reported then I can file it as such. I am also ok if any of the Excel-MVPs want to file it as a bug.
Let's say in sheet1 in cell A1, you have a formula = $B$2+ $B$3. Now ensure that your cell is selected. Now paste this code in a module.
Sub Sample()
Dim r As Range, sPre As String, sAft As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
sPre = "$B$2": sAft = "$C$3"
On Error Resume Next
Set r = ws.Range("A1:A2").SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not r Is Nothing Then r.Replace what:=sPre, _
replacement:=sAft, _
lookat:=xlPart, _
MatchCase:=False
End Sub
Ideally the code should have worked and the = $B$2+ $B$3 should have changed to = $C$3+ $B$3 in the formula bar but it doesn't. It will work only if you step through it or if you do as mentioned in the next line
Now do one thing. Select any cell other than A1 or A2. Now if you run the code, the code works as expected.
At first I thought that my excel has gone crazy so I closed and re-started it but I was able to reproduce the above in Excel 2010 many number of times.
Then I thought it is a .SpecialCells issue but the above behavior can be observed with this code as well.
Sub Sample()
Dim r As Range, sPre As String, sAft As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
sPre = "$B$2": sAft = "$C$3"
Set r = ws.Range("A1:A2")
r.Replace what:=sPre, _
replacement:=sAft, _
lookat:=xlPart, _
MatchCase:=False
End Sub
Are you able to replicate it?
I replicated your issue and got away with it by two ways:
Try ThisWorkbook.Save after the replace.
select other cell than A1 or A2 (cell selected whose formula getting replaced) after replacing formula.
While many alternatives have been suggested in the other answers for example
Select another cell via code
Save the workbook
If I do not want to select the cell or save the workbook then is there an alternate way which is better than the above two? Yes, there is. Just tried this and it works
Sub Sample()
Dim r As Range, sPre As String, sAft As String
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
sPre = "$B$2": sAft = "$C$3"
On Error Resume Next
Set r = ws.Range("A1:A3").SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not r Is Nothing Then r.Replace what:=sPre, _
replacement:=sAft, _
lookat:=xlPart, _
MatchCase:=False
r.Formula = r.Formula
End Sub
But the question still remains that the Formula Bar should have updated in the original scenario but it doesn't
I'm partly able to replicate it, also Excel 2010.
If I run the macro with the cell selected, using the Run option within the Visual Basic Editor, the value in the cell changes to reflect the new formula, but the formula in the formula bar doesn't show as updated. But it must be updated because the result changed. If I click out of the cell and back in, the updated formula appears and shows that the search/replace worked.
If I step through the macro in the VBA window, the formula bar does show as updated while the macro runs.
If I run the macro from the Excel window, using Macros -> View -> Run, the formula bar does show as updated while the macro runs.
If I add r.Select to the last line of the macro, running it from VBA works.
If I run the macro so it does not update the formula bar, then click into the formula bar, the formula bar shows the old formula but the cell content changes to show the new formula instead of the answer.
Edit: The behaviour appears the same in Excel 2013

VBA ChangePivotCache Run-time Error 13: Type Mismatch

The Issue:
You are my last hope. I've been working on this issue for three days now with no luck (and frustratingly little information on the Internet...)
I have a macro that makes a copy of the 'master' file (copies a few modules and a few sheets into the new copy). One of the copied sheets contains several pivots and slicers which reference the 'master' file's data.
This copy of the master file doesn't contain the entire dataset like the master file does and these cuts will be used by different users, so I don't want the pivots to reference the master dataset. So my challenge has been to change the source data for each pivot (preferably all on the same PivotCache) and then connect the applicable slicers to the necessary pivots.
My code to disconnect the slicers from the pivots works fine, and my code to reconnect the slicers works fine. I just can't get the first pivot to change data sources.
The frustrating thing is that on two separate occaisions I've made it work, only to have it throw the Run-time error '13': Type mismatch the next time I test it.
My first thought was that I hadn't been specific enough with workbook/sheet names, so I modified my code to reflect the exact workbook and sheet. Alas, the error still exists. The referenced workbook and sheet both exist, there are no missing column headers, there is a pivot with the name PivotTable1, and my range is being set correctly.
The error is thrown on the second line of the With statement.
My Code (Excerpt):
Dim pTable As PivotTable
Dim LEADData As Range
Dim sCache As SlicerCache
Dim pCache As PivotCache
thislastrow = Sheets("LEAD Data").Range("B" & Rows.Count).End(xlUp).Row
Set LEADData = Workbooks(cutwkbk2).Sheets("LEAD Data").Range("B9:AT" & thislastrow)
'Workbooks(cutwkbk2).Activate
With Workbooks(cutwkbk2).Sheets("Cabinet Reporting")
'Debug.Print .PivotTables("PivotTable1").SourceData
.PivotTables("PivotTable1").ChangePivotCache Workbooks(cutwkbk2).PivotCaches.Create(xlDatabase, LEADData)
End With
I've also tried using a pivot index like .PivotTables(1), but that also throws the error. The baffling part to me is how it's worked on two separate occaisions, but then fails even though nothing has changed between tests...
Please offer suggestions! I'm at a loss with this!
A shot in the dark.. Try this (UNTESTED)
Sub Sample()
Dim pTable As PivotTable
Dim sCache As SlicerCache
Dim pCache As PivotCache
Dim LEADData As String
thislastrow = Sheets("LEAD Data").Range("B" & Rows.Count).End(xlUp).Row
LEADData = "LEAD Data!" & "R9C2:R" & thislastrow & "C46"
With Workbooks(cutwkbk2).Sheets("Cabinet Reporting")
.PivotTables("PivotTable1").ChangePivotCache Workbooks(cutwkbk2).PivotCaches.Create(xlDatabase, LEADData)
End With
End Sub
On Second thoughts, something like this
Sub Sample()
Dim pTable As PivotTable
Dim sCache As SlicerCache
Dim pCache As PivotCache
Dim LEADData As String
thislastrow = Sheets("LEAD Data").Range("B" & Rows.Count).End(xlUp).Row
LEADData = ThisWorkbook.Path & "[" & _
ThisWorkbook.Name & _
"]LEAD Data!" & _
"R9C2:R" & thislastrow & "C46"
With Workbooks(cutwkbk2).Sheets("Cabinet Reporting")
.PivotTables("PivotTable1").ChangePivotCache Workbooks(cutwkbk2).PivotCaches.Create(xlDatabase, LEADData)
End With
End Sub