I am trying to dynamically retrieve the range address of data then change the pivot table data source range address.
There are three sheets involved.
1) ThisWorkbook.Worksheets("sheet1") - main dashboard, has pivot chart and slicer that were moved from sheet2
2) ThisWorkbook.Worksheets("sheet2") - Pivot Table
3) ThisWorkbook.Worksheets("sheet3") - source data that was copied from different workbook before the below code runs.
My code gives
Run-time error 5: Invalid Procedure call or argument
The error points to Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
I have two other pivot charts on my main sheet. Using the same code they refresh without any issues.
Full code:
Option Explicit
Sub test()
Dim daMa As Worksheet
Dim daPerf As Worksheet
Dim LastRow As Long
Dim LastCol As Long
Dim Data_sht As Worksheet
Dim Pivot_sht As Worksheet
Dim DataRange As Range
Dim PivotName As String
Dim NewRangePH As String
Dim pt As PivotTable
Dim pc As PivotCache
'REFRESHING PERFORMANCE HISTORY
'Set Variables Equal to Data Sheet and Pivot Sheet
Set Data_sht = ThisWorkbook.Worksheets("sheet3")
Set Pivot_sht = ThisWorkbook.Worksheets("sheet2")
'Enter in Pivot Table Name
PivotName = "PHPivot"
With Data_sht
.Activate
'Dynamically Retrieve Range Address of Data
LastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
LastCol = 12
Set DataRange = Data_sht.Range(Cells(LastRow, 1).Address, Cells(1, LastCol).Address)
End With
NewRangePH = Data_sht.Name & "!" & _
DataRange.Address(ReferenceStyle:=xlR1C1)
'Make sure every column in data set has a heading and is not blank (error prevention)
If WorksheetFunction.CountBlank(DataRange.Rows(1)) > 0 Then
MsgBox "One of your data columns has a blank heading." & vbNewLine _
& "Please fix and re-run!.", vbCritical, "Column Heading Missing!"
Exit Sub
End If
'Change Pivot Table Data Source Range Address
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=NewRangePH)
Set pt = Pivot_sht.PivotTables(PivotName).ChangePivotCache(pc)
End Sub
I searched through many Google result and results from Stack Overflow and tried at least 10 different things before posting this question.
"set pt = " is worng, you do not want to set a new pivottable.
Instead use
Pivot_sht.PivotTables(PivotName).ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
newRangePH, Version:=xlPivotTableVersion15)
Related
I have a dashboard (Sheet "Dashboard") with set of pivot tables that rely on a dynamic data set on a specific sheet of the same workbook (Sheet "Dashboard_Data").
Currently the user is prompted to select a cell on the sheet with the raw data (due to possible different sheet name), the macro then combines the necessary data on the Dashboard Data sheet and the pivot tables are updated.
This works without any problems as long as the raw data is on a sheet in the same workbook.
I am trying to find a solution so that that the user can select the raw data on a sheet that is not in the same workbook. When I run it as is I am getting a subscript out of range error.
Option Explicit
Sub HB_Run_Dashboard()
Dim Ws As Worksheet, lastRow As Long
Dim myNamedRange As Range, Rng As Range, c As Range, destrange As Range
Dim myRangeName As String
Dim desiredSheetName As String
Dim SearchRow As Long
Dim StartatRow As Long
Dim pvt As PivotTable
Dim S As String
'user prompt to locate cell in the sheet with the raw data to capture sheet name
desiredSheetName = Application.InputBox("Select any cell inside the source sheet: ", _
"Prompt for selecting target sheet name", Type:=8).Worksheet.Name
'currently a test code to also have the user find the location of the sheet
'Inputsheetpath = Application.GetOpenFilename(FileFilter:= _
"Excel Workbooks (*.xls*),*.xls*,*.xlsb,*.xlsm", Title:="Open Database File")
'this is where i am stuck. how to set the WS with the correct path info to avoid subscript out of range
Set Ws = Workbook.Worksheets(desiredSheetName)
SearchRow = InputBox("Row # where Reference 'Dashboard' is entered.", "Row Input")
StartatRow = InputBox("Row # where Headers are located.", "Row Input")
'Const SearchRow As Long = SRow
'Const StartAtRow As Long = StRow
Const RangeName As String = "Dashboard_Data_Raw"
lastRow = Ws.Cells(Ws.Rows.Count, "A").End(xlUp).Row
'loop cells in row to search...
For Each c In Ws.Range(Ws.Cells(SearchRow, 1), _
Ws.Cells(SearchRow, Columns.Count).End(xlToLeft)).Cells
If LCase(c.Value) = "dashboard" Then 'want this column
'add to range
BuildRange myNamedRange, _
Ws.Range(Ws.Cells(StartatRow, c.Column), Ws.Cells(lastRow, c.Column))
End If
Next c
Debug.Print myNamedRange.Address
Worksheets(desiredSheetName).Names.Add Name:=RangeName, RefersTo:=myNamedRange
Instead of:
Dim desiredSheetName As String
desiredSheetName = Application.InputBox("Select any cell inside the source sheet: ", _
"Prompt for selecting target sheet name", Type:=8).Worksheet.Name
you can do this:
Dim desiredSheet As Worksheet
Set desiredSheet = Application.InputBox("Select any cell inside the source sheet: ", _
"Prompt for selecting target sheet name", Type:=8).Worksheet
Then desiredSheet is a reference to the user-selected worksheet
I am working with a workbook where you can choose a list of countries in a dropdown menu.
When changing the name, the Pivot table is updated to the corresponding Worksheet and Table.
The Pivot updating works and it changes the source depending on the country chosen.
The next step is that I want some data from the table that we connected to the worksheet to do some calculations.
If I choose the name of the worksheet and table directly in the "set" step, they are not changing depending on my dropdown selection.
Sub NORDICS()
Dim tblName As String
Dim ws1 As Worksheet
Dim ams As Long
Dim Target As Variant
Dim average As Variant
Dim tbl As ListObject
Set ws1 = Worksheets("Nordics")
Set tbl = ws1.ListObjects("TableNordics")
''What is the Table Name
Range("E3").Formula = "=""Table""&F3"
''Set tblName to the "calculated" table name above
tblName = Range("E3")
''Update the source to "PivotTable1" to be the tblName
Application.CutCopyMode = False
ActiveSheet.PivotTables("PivotTable1").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
tblName, Version:=6)
ActiveSheet.ChartObjects("Chart 1").Activate
ActiveChart.FullSeriesCollection(2).Points(53).Select
Selection.Format.Line.EndArrowheadStyle = msoArrowheadStealth
''Collect the Last row of the Table Body
ans = tbl.DataBodyRange.Rows.Count
''Collect the Last cell value of column 8 and last row calculated above
Target = tbl.DataBodyRange(ans, 8).Value
''Collect the Total Rows Value from the Table
With tbl
average = .TotalsRowRange.Cells(.ListColumns.Count).Value
End With
''Calculate the average vs Target value and put in "W3"
Range("W3") = average - Target
''Remove Calculations done on worksheet that is not needed any more
Range("E3").Formula = "="""""
Range("E3").Value = Range("E3").Value
End Sub
My end goal would be that
Set ws1 = Worksheets("Nordics")
Set tbl = ws1.ListObjects("TableNordics")
is
Set ws1 = Worksheets = Range("F3")
Set tbl = ws1.ListObjects = Range("E3")
I am struggling to find a solution to the issue I am having; I've been looking all over. I'm not sure if it is how I am obtaining my first row or if it is something else. I have the exact same code (below) setup for another macro but that macro pulls R1C1:lastrow/lastcol. The only difference is: this macro attempts to use a dynamic first row (instead of Set PRange = glData.Cells(1, 1).Resize(LastRow, LastCol)) . I've even tried setting the first row as R10C1(the header row of the source data) and I still get an "Application-defined or object-defined error".
Macro use: Creates pivot table based on source data in range A(y):N(x); x = dynamic lastrow/col, y = dynamic first row. Destination is 4 columns to the right of another pivot table(created by a different sub). They will not overlap (unless something is hidden). I have made this setup manually and it works fine.
Any help is appreciated.
Sub CreateFAPiv()
'
Dim PSheet As Worksheet
Dim wsData As Worksheet: Set wsData = Sheets("Data")
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim PRange As Range
Dim LastRow As Long
Dim LastCol As Long
Dim asset As String
Dim glData As Worksheet: Set glData = Sheets("GL")
asset = glData.Range("B2").Value
Set PSheet = Worksheets("Piv")
'Define Data Range
FirstRow = IIf(IsEmpty(glData.Range("C1")), glData.Range("C1").End(xlDown).Row, 1)
LastRow = glData.Cells(Rows.Count, 1).End(xlUp).Row
LastCol = glData.Cells(1, Columns.Count).End(xlToLeft).Column
Set PRange = glData.Cells(FirstRow, 1).Resize(LastRow, LastCol)
'Define Pivot Cache - This is where I am getting the error
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=PRange). _
CreatePivotTable(TableDestination:=PSheet.Cells(3, 4), _
TableName:="DataPivotTable")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(3, 4), TableName:="DataPivotTable")
.....Rest of code....
End Sub
Currently I have code (below) that goes through and finds all charts and tables inside my workbook, takes their names as an array and pastes them onto a table as a data validation dropdown so that whomever is using the workbook can decide which tables and graphs to auto generate into a PowerPoint Presentation. Now I am trying to write code that also will do the same for named ranges. So not charts or tables. For some reason this seems to be way harder than I logically thought it would be. If anything I figured getting tables and charts to work would've been more of a headache but that has not been the case
Code and Picture of the aforementioned table are shown below
CODE:
Dim xlBook As Workbook
Dim xlSheet As Worksheet
Dim xlTable As ListObject
Dim xlTableColumn As ListColumn
Dim xlChartObject As ChartObject
Dim xlTableObject As ListObject
Dim ObjectArray() As String
Dim ObjectIndexArray As Integer
Dim ExcRng As Range
'set the book
Set xlBook = ThisWorkbook
'loop through each worksheet
For Each xlSheet In xlBook.Worksheets
'if we have charts
If xlSheet.ChartObjects.Count > 0 Then
'grab each chart name
For Each xlChartObject In xlSheet.ChartObjects
'update count
ObjectArrayIndex = ObjectArrayIndex + 1
ReDim Preserve ObjectArray(ObjectArrayIndex)
'add the chart object to array
ObjectArray(ObjectArrayIndex) = xlChartObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlChartObject)
Next
End If
'if we have tables
If xlSheet.ListObjects.Count > 0 Then
'grab each table name
For Each xlTableObject In xlSheet.ListObjects
'update count
ObjectArrayIndex = ObjectArrayIndex + 1
ReDim Preserve ObjectArray(ObjectArrayIndex)
'add the table object to array
ObjectArray(ObjectArrayIndex) = xlTableObject.Name & "-" & xlSheet.Name & "-" & TypeName(xlTableObject)
Next
End If
Next
'grab sheet
Set xlSheet = xlBook.Worksheets("Export")
'grab table from sheet
Set xlTable = xlSheet.ListObjects("ExportToPowerPoint")
'grab object column from table
Set xlTableColumn = xlTable.ListColumns("Object")
'set the validation dropdown
With xlTableColumn.DataBodyRange.Validation
'delete old
.Delete
'add new data
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(ObjectArray, ",")
'make sure it's a dropdown
.InCellDropdown = True
End With
PICTURE OF TABLE
As you can see from the picture; column A is where I have the references going. And as you can see the one chart and table that I have named so far for my workbook are showing up fine--so my code so far for Graphs and Tables seems to be working great. I now just need it to also populate named ranges on that same column A
ThisWorkbook.Names contains a reference to all the Names in the Workbook including Named Ranges.
I wrote a function to add the Named Ranges to an array.
Code
Function GetNamedRanges(SheetName As String) As Variant()
Dim Results As Variant
ReDim Results(1 To ThisWorkbook.Names.Count)
Dim Count As Long
Dim Name As Name
Dim Target As Range
For Each Name In ThisWorkbook.Names
On Error Resume Next
Set Target = Name.RefersToRange
If Err.Number = 0 Then
If Target.Parent.Name = SheetName Or Len(SheetName) = 0 Then
Count = Count + 1
Set Results(Count) = Target
On Error GoTo 0
End If
End If
Next
ReDim Preserve Results(1 To Count)
GetNamedRanges = Results
End Function
Usage
AllNames = GetNamedRanges
Sheet1Names = GetNamedRanges(Sheet1.Name)
Hi I'm looking to create code for copying certain columns (AH to AX) across all worksheets then skipping worksheets named "Aggregated" & "Collated Results"
I have this already
Sub FillSheets()
Dim ws As Worksheets
Dim worksheetsToSkip As Variant
Dim rng As Range
Dim sh As Sheet1
Set rng = sh.Range("AH1:AX7200")
worksheetsToSkip = Array("Aggregated", "Collated Results")
For Each ws In Worksheets
If IsError(Application.Match(ws.Name, worksheetsToSkip, 0)) Then
End Sub
This will
Loop through sheets
"Copy" data from AH1 - AX1 down to the last used row that is determined by Column AH (Update column if needed)
"Paste" data on a sheet named Sheet1 (Update if needed). The data will be pasted in Column AH on the first available blank row. It's not clear what column you want to paste the data in. You just need to change AH to Some Column to modify
"Copy" and "Paste" are in quotes because we are really just transferring values here since this is quicker. We are actually setting the values of two equal sized ranges equal to each other.
Option Explicit
Sub AH_AX()
'Update "Sheet1" to sheet where data is being pasted
Dim ms As Worksheet: Set ms = ThisWorkbook.Sheets("Sheet1")
Dim ws As Worksheet, wsLR As Long, msLR As Long
Dim CopyRange As Range, PasteRange As Range
For Each ws In Worksheets
If ws.Name <> "Aggregated" And ws.Name <> "Collated Results" Then
'Determine last rows
wsLR = ws.Range("AH" & ws.Rows.Count).End(xlUp).Row
msLR = ms.Range("AH" & ms.Rows.Count).End(xlUp).Offset(1).Row
'Set Ranges
Set CopyRange = ws.Range("AH1:AX" & LR)
Set PasteRange = ms.Range("AH" & msLR).Resize(CopyRange.Rows.Count, CopyRange.Columns.Count)
'Value Transfer (Quicker than copy/paste)
PasteRange.Value = CopyRange.Value
End If
Next ws
End Sub