I need some help with this one. I am trying to create a pivot table, starting in Q1, of a range of data in the same sheet. The first if-statement is there because the last column doesn't always contain a header, so I include it there.
I want the range to be dynamic since the size of the tables being made will vary depending on the number of rows of the data in the sheet. The source data is always A1:O & lastRow and the table always needs to be placed in Q1 of the same sheet.
I am getting an error - "Invalid call or procedure" - screenshot below.
The issue line when debugging is where I set the pivot table - also in screenshot below.
If it helps, I am running this code from a separate sheet in a start-up folder.
Any help here would be greatly appreciated!
UPDATED TO SHOW CURRENT CODE USING COMMENT SUGGESTIONS
Sub aaTemp()
'
' aaTemp Macro
'
If Range("O1").Value = "" Then
Range("O1").Value = "Notes"
Else
End If
Dim lastRow, lastColumn As Long
lastRow = ActiveSheet.Range("B65536").End(xlUp).row
lastColumn = 15
'Dim pivotSource As String
'pivotSource = "'" & ActiveSheet.Name & "'!" & Range("A1:O" & lastRow).Address(ReferenceStyle:=xlR1C1)
'Dim pivotDestination As String
'pivotDestination = "'" & ActiveSheet.Name & "'!" & Range("Q1").Address(ReferenceStyle:=xlR1C1)
Dim ws As Worksheet
Dim wb As Workbook
Dim pc As PivotCache
Dim pt As PivotTable
Set ws = ActiveSheet
Set wb = ThisWorkbook
Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, _
sourceData:=ActiveSheet.Range("A1:O" & lastRow), _
Version:=xlPivotTableVersion15)
Columns("Q:Z").delete Shift:=xlToLeft
Set pt = ws.PivotTables.Add(PivotCache:=pc, _
TableDestination:=ActiveSheet.Range("Q1"), _
TableName:="PTPivotTable")
End Sub
Sub aaTemp()
'
' aaTemp Macro
'
If Range("O1").Value = "" Then
Range("O1").Value = "Notes"
Else
End If
Dim lastRow, lastColumn As Long
lastRow = ActiveSheet.Range("B65536").End(xlUp).row
lastColumn = 15
Dim ws As Worksheet
Dim wb As Workbook
Dim pc As PivotCache
Dim pt As PivotTable
Set ws = ActiveSheet
Set wb = ActiveWorkbook 'This was the needed change
Set pc = wb.PivotCaches.Create(SourceType:=xlDatabase, _
sourceData:=ActiveSheet.Range("A1:O" & lastRow), _
Version:=xlPivotTableVersion15)
Columns("Q:Z").delete Shift:=xlToLeft
Set pt = ws.PivotTables.Add(PivotCache:=pc, _
TableDestination:=ActiveSheet.Range("Q1"), _
TableName:="PTPivotTable")
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 sorry if this is basic but I can't seem to figure this out .
Long story short my file has several tabs with lot's of data and each tab has a pivot table. What I need is a Macro that adjusts the data range of the Pivot table to the data in current sheet. I have it now set with a bigger range giving me Blanks which drives me nuts.
Here is my code :
Dim Data_Sheet As Worksheet
Dim Pivot_Sheet As Worksheet
Dim StartPoint As Range
Dim DataRange As Range
Dim PivotName As String
Dim NewRange As String
Dim LastCol As Long
Dim lastRow As Long
'Set Pivot Table & Source Worksheet
Set Data_Sheet = ThisWorkbook.Worksheets("1")
Set Pivot_Sheet = ThisWorkbook.Worksheets("1")
'Enter in Pivot Table Name
PivotName = "PivotTable1"
'Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("V2")
LastCol = StartPoint.End(xlToRight).Column
DownCell = StartPoint.End(xlDown).Row
Set DataRange = Data_Sheet.Range(StartPoint, Cells(DownCell, LastCol))
NewRange = Data_Sheet.Name & "!" & DataRange.Address(ReferenceStyle:=xlR1C1)
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange _
, Version:=6)
Now when I try this I get the "Run time error -2147024809" error stating that The pivottable name is invalid .
This updates all the sheets that have 1 pivot table
Sub Update()
Dim wb As Workbook, ws As Worksheet
Dim rng As Range, cell As Range, newrange As String
Set wb = ActiveWorkbook
For Each ws In wb.Sheets
With ws
If .PivotTables.Count = 1 Then
Set cell = .Range("V2").End(xlToRight).End(xlDown)
Set rng = .Range("V2", cell)
newrange = "'" & ws.Name & "'!" & rng.Address(ReferenceStyle:=xlR1C1)
.PivotTables(1).ChangePivotCache _
wb.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=newrange, Version:=6)
End If
End With
Next
End Sub
Below is my code, where I am facing an issue. From different workbooks I need to create 3 new sheets in new workbook. In one I have to filter data based on name of sheet from another workbook. I've stucked with copy filtered data to a new workbook. before that all works fine.
Sub Click()
Dim xRow As Long
Dim wbnew, wb1, wb2, wb3, wb4 As Workbook
Dim sht, Data As Worksheet
Dim sh1, sh2, Filter As String
Dim Name As String
Dim rng As Range
'openin files to work with
Workbooks.Open filename:="C:\Users\File1.xlsx", ReadOnly:=True
Workbooks.Open filename:="C:\Users\File2.xlsx", ReadOnly:=True
Workbooks.Open filename:="C:\Users\File3.xlsx", ReadOnly:=True
Workbooks.Open filename:="C:\Users\File4.xlsx", ReadOnly:=True
wb1 = "File1.xlsx"
wb2 = "File2.xlsx"
Set wb3 = Workbooks("File3.xlsx")
'here I create a temporary file
Set wbnew = Workbooks.Add
ActiveSheet.Name = "Data"
'defining columns I will work with
sh1 = wb3.ActiveSheet.Range("A" & i).Value
sh2 = wb3.ActiveSheet.Range("B" & i).Value
Name = wb3.ActiveSheet.Range("F" & i).Value
Filter = wb3.ActiveSheet.Range("C" & i).Value
'main goal is to copy data from 3 different files to new workbook. Below starting with copying data
Workbooks(wb1).Worksheets(sh1).Copy _
Before:=wbnew.Sheets(1)
Workbooks(wb2).Worksheets(sh2).Copy _
Before:=wbnew.Sheets(2)
'from third file I have to autofilter data for column U in File4.xlsx with criteria from File3.xlsx defined above
Set wb4 = Workbooks("File4.xlsx")
wb4.Activate
xRow = wb4.Worksheets("Transactions").Range("A1").End(xlDown).Row
wb4.Worksheets("Transactions").AutoFilterMode = False
wb4.Worksheets("Transactions").Range("A:U").AutoFilter Field:=21, Criteria1:=Filter, Operator:=xlFilterValues
'try to copy result from autofilter to new workbook to have 3 new sheets, but having an error, also I tried range copy without success
Workbooks(wb4).ActiveSheet.Range("A1:U" & xRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wbnew.Sheets("Data")
wb4.Worksheets("Transactions").AutoFilterMode = False
End Sub
I appreciate your advice. Thank you
(Written on my phone, there may be typos): Use advanced filter:-
Sub Click()
Dim xRow As Long
Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wbNew as workbook
Dim sht as worksheet, Data As Worksheet
Dim sh1 as string, sh2 as string, Filter As String
Dim Name As String
Dim rng As Range
'openin files to work with
set wb1 = Workbooks.Open(filename:="C:\Users\File1.xlsx", ReadOnly:=True)
set wb2 = Workbooks.Open(filename:="C:\Users\File2.xlsx", ReadOnly:=True)
set wb3 = Workbooks.Open(filename:="C:\Users\File3.xlsx", ReadOnly:=True)
set wb4 = Workbooks.Open(filename:="C:\Users\File4.xlsx", ReadOnly:=True_
set wbNew = workbooks.add()
dim i as long 'this was missing
i = 1 'what should this be?
'defining columns I will work with
with wb3.Sheets(1)
sh1 = .Range("A" & i).Value
sh2 = .Range("B" & i).Value
Name = .Range("F" & i).Value
Filter = .Range("C" & i).Value
end with
wb3.close false
'main goal is to copy data from 3 different files to new workbook. Below starting with copying data
wb1.Worksheets(sh1).Copy Before:=wbnew.Sheets(1)
wb1.close false
wb2.Worksheets(sh2).Copy before:=wbnew.Sheets(2)
wb2.close false
'from third file I have to autofilter data for column U in File4.xlsx with criteria from File3.xlsx defined above
with wb4.Worksheets("Transactions")
xRow =.Range("A1").End(xlDown).Row
.range("Z1") = .range("U1") 'I assume Z is clear - insert heading
.range("Z2") = filter 'insert value
.range("a1:u1").copy wbnew.sheets("Data").range("a1") 'copy headings
.range("a1:u" & xrow).AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=.range(2z1:z2"), _
CopyToRange:=wbnew.Sheets("Data").range("A1:u1")
End With
End Sub
You need to specify a range for your destination:
Workbooks(wb4).ActiveSheet.Range("A1:U" & xRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wbnew.Sheets("Data").Range("A1:U" & xRow)
I've created a program that copies over a pivot table from another workbook, but I need it to refer to the worksheet in the current file.
So for example, in the original file it refers to "QueryResults" as the source, and I need it to refer to the "QueryResults" in the new file after it is transferred over. Does anyone have any ideas on how to do this?
I've tried unsuccessfully to recreate the cache, but get an error when running it in my code.
ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=Worksheets("QueryResults").Range("A1:AY" & _
Worksheets("QueryResults").Cells(Rows.Count, 1).End(xlUp).Row).Address(External:=True), _
Version:=xlPivotTableVersion14)
Try
Sub setPivot()
Dim pv As PivotTable
Dim Ws As Worksheet
Dim wsData As Worksheet
Dim rngDB As Range, strRng As String
Dim r As Long
Set Ws = ActiveSheet
Set pv = Ws.PivotTables(1)
Set wsData = Sheets("QueryResults")
With wsData
r = .Range("a" & Rows.Count).End(xlUp).Row
Set rngDB = .Range("A1:AY" & r)
End with
strRng = rngDB.Address(, , xlR1C1, 1) 'not xlA1
With pv
.SourceData = strRng
.RefreshTable
End With
End Sub
I'm trying to change my fixed range (A1:G4193) to one that's dynamic due to the need for new data to be entered on a daily basis.
Here is my code:
Sub Create_Pivot()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As String
Dim SrcData As String
Dim pf As PivotField
SrcData = ActiveSheet.Name & "!" & Range("A1:G4193").Address(ReferenceStyle:=xlR1C1)
Set sht = Sheets.Add
StartPvt = sht.Name & "!" & sht.Range("A1").Address(ReferenceStyle:=xlR1C1)
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")
I highly appreciate any help. Thanks!
Assumption - your Pivot Table's dynamic range is changing by the number of rows added (or distracted), while the number of columns stays constant.
Instead of using ActiveSheet, try using referenced objects, like Set SrcSht = Worksheets("Sheet1") and then use that variable.
Try the code below (some of my other modifications are inside the code's notes).
Option Explicit
Sub Create_Pivot_DynamicRange()
Dim sht As Worksheet
Dim pvtCache As PivotCache
Dim pvt As PivotTable
Dim StartPvt As Range
Dim SrcData As String
Dim pf As PivotField
Dim SrcSht As Worksheet, LastRow As Long
' modify "Sheet1" to your sheet's name
Set SrcSht = Worksheets("Sheet1")
With SrcSht
' find last row with data in Column A (skip blank cells in the middle)
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
' set source data to dynamic number of rows (string)
SrcData = .Name & "!" & .Range("A1:G" & LastRow).Address(ReferenceStyle:=xlR1C1)
End With
Set sht = Sheets.Add
' set the start position directly to a Range (there's no need to use a String as a "middle-man")
Set StartPvt = sht.Range("A1")
Set pvtCache = ActiveWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=SrcData)
Set pvt = pvtCache.CreatePivotTable( _
TableDestination:=StartPvt, _
TableName:="PivotTable1")
End Sub
Change your range to a variable - like RNG
The calculate the range , how ever you plan to do it. Last row, last column, last cell address, etc
Then make the code soething like this
Lastrow = ActiveSheet..Range("B" & Worksheets("All_Data").Rows.Count).End(xlUp).Row
RNG = "A1:"G" & Lastrow
SrcData = ActiveSheet.Name & "!" & Range(RNG).Address(ReferenceStyle:=xlR1C1)