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
Related
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
Hoping someone can help me figure out what's missing from my code. I have a validation list on one sheet, and I'm attempting to loop that list on a different sheet and change the filter on pivot table on that different sheet. The loop works through the validation list if I run the macro on the sheet with that validation cell, but on the sheet with my pivot table it only loops through the cells on that sheet. Consequently, if I'm on the sheet with the validation list, the loop works correctly through that validation list, but the pivot table filter doesn't change. I'm sure I'm missing something simple but I can't figure out what it is. Thanks in advance.
Sub Addvalidationlist() ' there's no problems with this macro, not the most elegant code but it works
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lastline As Long, newlastline As Long
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Set wb = ThisWorkbook
Set sh1 = wb.Sheets("qry_FB_forecast_file_NEW")
With sh1
lastline = sh1.Range("A" & Rows.Count).End(xlUp).Row
Set rng = sh1.Range("H1:H" & lastline)
rng.Copy Range("X:X")
sh1.Range("X:X").RemoveDuplicates Columns:=1, Header:=xlYes
newlastline = sh1.Range("X" & Rows.Count).End(xlUp).Row
Set rng2 = sh1.Range("X2:X" & newlastline)
Set rng3 = sh1.Range("Y1")
With rng3.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:="='" & sh1.Name & "'!" & rng2.Address
End With
End With
' end of validation list sub
**Public Sub exportbybrand()** *This is the one I'm having trouble with *
Dim wb As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lastline As Long, newlastline As Long
Dim rng As Range
Dim rng2 As Range
Dim rng3 As Range
Dim valcell As Range
Dim valcellsource As Range
Dim Family As String
Set wb = ThisWorkbook
Set sh1 = wb.Worksheets("qry_FB_forecast_file_NEW")
Set valcell = ThisWorkbook.Worksheets("qry_FB_forecast_file_NEW").Range("Y1")
Set valcellsource = Evaluate(valcell.Validation.Formula1)
Set sh2 = wb.Worksheets("MR Front Edit")
On Error Resume Next
With sh1
For Each valcell In valcellsource
valcell.Value = valcell.Value
Family = valcell
MsgBox Family
With sh2
sh1.PivotTables("PivotTable1") _
.PivotFields("FamilyId").CurrentPage = Family
End With
Next
End With
End Sub
Image error
Dears;
I find a error in bellow code in depurator the VBA point this:
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
The code below:
Sub UpdatePivotTableRange()
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("BASE")
Set Pivot_Sheet = ThisWorkbook.Worksheets("TABELA")
'Enter in Pivot Table Name
PivotName = "Tabela dinâmica3"
'Defining Staring Point & Dynamic Range
Data_Sheet.Activate
Set StartPoint = Data_Sheet.Range("A1")
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)
'Change Pivot Table Data Source Range Address
Pivot_Sheet.PivotTables(PivotName). _
ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRange)
'Ensure Pivot Table is Refreshed
Pivot_Sheet.PivotTables(PivotName).RefreshTable
'Complete Message
Pivot_Sheet.Activate
MsgBox "Relatório " & PivotName & " foi atualizado. Aperte OK."
End Sub
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)