VBA: Updating Pivots Issues - excel

I am relatively new to VBA, at the moment when trying to update a pivot, I get the following error Run-time error 1004,
The Pivot seems not to be taking the data set correctly as on the pivot there are missing dates which are correctly formatted on the Dataset.
When I run the macro it stops right on DateVal line, please feel free to ask for more details if needed.
I tried adding manually dates that are part of the dataset with the same result but if I select dates running the Record Macro it'll work but and the if I run the macro created by the Recorder I would get the same Error, I hope you can show me where I am wrong on this code.
Sub UpdatePivots()
Application.ScreenUpdating = False
Dim DateVal As String
DateVal = Sheets("home").[G16]
DateFormat = Sheets("home").[Q10]
' Find the last row with data in column A
Sheets("GLViewFinanceCycleCounts").Select
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False 'Remove Filters if exists
LastRow = ActiveSheet.Range("C1").Offset(ActiveSheet.Rows.Count - 1, 0).End(xlUp).Row
pName = ActiveWorkbook.Path ' the path of the currently active file
wbName = ActiveWorkbook.Name ' the file name of the currently active file
shtName = ActiveSheet.Name ' the name of the currently selected worksheet
DatasetRange = Range("A1:BM" & LastRow).Address(ReferenceStyle:=xlR1C1)
DatasetPT = pName & "\[" & wbName & "]" & shtName & "!" & DatasetRange
' Pivot Updates
' CompletesAndSH page
Sheets("CompletesAndSH").Select ' Pivot Table Page
ActiveSheet.PivotTables("PivotTable41").ChangePivotCache ActiveWorkbook. _
PivotCaches.Create(SourceType:=xlDatabase, SourceData:=DatasetPT, Version:= _
xlPivotTableVersion14)
ActiveWorkbook.RefreshAll
' Filter to selected month
ActiveSheet.PivotTables("PivotTable41").PivotFields("A$Period Name").ClearAllFilters
ActiveSheet.PivotTables("PivotTable41").PivotFields("A$Period Name").CurrentPage = DateVal

Related

Save new workbook with data from multiple sheets

I am fairly new at using VBA to manipulate data in Excel. I am trying to build about 800 bills of materials from data I have extracted from an old system we are replacing.
I have an Excel workbook with multiple sheets with a table on each sheet. What I need to do is work through every "ParentID" in one sheet and save each unique "Parent ID" and "ChildID" to a new workbook titled with the ParentID. Then lookup each unique "ChildID" in another worksheet and save data from this worksheet to the new workbook for each unique "ChildID".
I found the below VBA code and have been working on changing things to work for me as I think this will get me at least part way there but I am having trouble getting all of the Template values replaced with my values due to lack of knowlege on syntax and VBA code.
If someone could help me identify what I need to replace to get at least this code working I think I would be well on my way.
Thanks!
Option Explicit
Sub ExportData()
'Declare variables
Dim ArrayItem As Long
Dim tblUsedIn As Worksheet
Dim ArrayOfUniqueValues As Variant
Dim SavePath As String
Dim ColumnHeadingInt As Long
Dim ColumnHeadingStr As String
Dim rng As Range
'Set the worksheet to
Set tblUsedIn = Sheets("tblUsedIn")
'Set the save path for the files created
SavePath = Range("File Save Location")
'Set variables for the column we want to separate data based on
ColumnHeadingInt = WorksheetFunction.Match(Range("ParentID").Value, Range("Data[#Headers]"), 0)
ColumnHeadingStr = "Data[[#All],[" & Range("ParentID").Value & "]]"
'Turn off screen updating to save runtime
Application.ScreenUpdating = False
'Create a temporary list of unique values from the column we want to
'separate our data based on
Range(ColumnHeadingStr & "").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("UniqueValues"), Unique:=True
'Sort our temporary list of unique values
tblUsedIn.Range("UniqueValues").EntireColumn.Sort Key1:=tblUsedIn.Range("UniqueValues").Offset(1, 0), _
Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
'Add unique field values into an array
'ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(tblUsedIn.Range("IV2:IV" & RotblUsedIn.Count).SpecialCells(xlCellTypeConstants))
ArrayOfUniqueValues = Application.WorksheetFunction.Transpose(tblUsedIn.Range("UniqueValues").EntireColumn.SpecialCells(xlCellTypeConstants))
'Delete the temporary values
tblUsedIn.Range("UniqueValues").EntireColumn.Clear
'Loop through our array of unique field values, copy paste into new workbooks and save
For ArrayItem = 1 To UBound(ArrayOfUniqueValues)
tblUsedIn.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt, Criteria1:=ArrayOfUniqueValues(ArrayItem)
tblUsedIn.Range("Data[#All]").SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
ActiveWorkbook.SaveAs SavePath & ArrayOfUniqueValues(ArrayItem) & Format(Now(), " YYYY-MM-DD hhmmss") & ".xlsx", 51
ActiveWorkbook.Close False
tblUsedIn.ListObjects("Data").Range.AutoFilter Field:=ColumnHeadingInt
Next ArrayItem
tblUsedIn.AutoFilterMode = False
MsgBox "Finished exporting!"
Application.ScreenUpdating = True
End Sub

Excel VBA to create new PivotCache and connect multiple Pivot Tables

I have a workbook with many pivot tables that are based on a range that is deleted and refreshed using VBA. Currently, to update the data source, as the last part of that sub routine, I recreate PivotCaches for each PivotTable and refresh.
I want just 6 of the tables to be linked together with one common PivotCache so they can share slicers etc and I cannot get it working.
I have looked all over for a solution to this but I keep coming up short and I have been stuck on it for a fair while now. I am reasonably new to VBA but I can usually work it out with trial and error but this one just has me stumped.
I obviously have done something wrong and any help to identify what, would be greatly appreciated.
Thanks :)
My current code is below (Note: I removed the non-related stuff from the code for ease of reading):
Sub RunReport()
On Error GoTo ErrorHandler
'############## Define Variables ##############
Dim WS_O As Worksheet 'Output sheet - report sheet
Dim WS_P As Worksheet 'Pivot table Sheet
Dim OuputRow As Integer 'First row for output of data
Dim LastRow_O As Integer 'Last used row of output sheet
Dim PivotCacheName As PivotCache
Dim PivotRange As String 'Range of data for Pivot Data Source
Dim PivotName1 As String 'Pivot Table Name Strings
Dim PivotName2 As String
Dim PivotName3 As String
Dim PivotName4 As String
Dim PivotName5 As String
Dim PivotName6 As String
'############## Modify Application Settings ##############
'Store current configuration
OriginalCalcMode = Application.Calculation
'Set configuration for fastest processing
Application.Calculation = xlManual
Application.ScreenUpdating = False
Application.EnableEvents = False
'############## Set Variable Values ##############
'Worksheets
Set WS_O = Sheets("Report") 'Output sheet - report sheet
Set WS_P = Sheets("Pivot Tables - Live Data") 'Pivot tables sheet
'Pivot Tables
PivotName1 = "PivotTable1"
PivotName2 = "PivotTable2"
PivotName3 = "PivotTable3"
PivotName4 = "PivotTable4"
PivotName5 = "PivotTable5"
PivotName6 = "PivotTable6"
'General
OutputRow = 7
'Used Ranges
LastRow_O = WS_O.Range("A" & Rows.Count).End(xlUp).Row
'############## Refresh Pivot Tables ##############
'Define Data Range
PivotRange = WS_O.Name & "!" & "A" & OutputRow - 1 & ":AM" & LastRow_O
'Error Handling
'Make sure every column in data set has a heading and is not blank
If WorksheetFunction.CountBlank(WS_O.Range("A" & OutputRow - 1 & ":AM" & LastRow_O).Rows(1)) > 0 Then
MsgBox "One or more columns in ''Report'' sheet has a blank heading;" & vbNewLine _
& "This has prevented the pivot tables from refreshing correctly." & vbNewLine & vbNewLine _
& "Please verify cells A" & OutputRow - 1 & ":AM" & OutputRow - 1 & " in ''Report'' sheet are not blank and try again.", vbCritical, "ERROR - Column Heading Missing"
GoTo EndSub
End If
'Change Pivot Data Sources to a single cache
Set PivotCacheName = ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange, Version:=xlPivotTableVersion15)
WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)
WS_P.PivotTables(PivotName2).ChangePivotCache (PivotCacheName)
WS_P.PivotTables(PivotName3).ChangePivotCache (PivotCacheName)
WS_P.PivotTables(PivotName4).ChangePivotCache (PivotCacheName)
WS_P.PivotTables(PivotName5).ChangePivotCache (PivotCacheName)
WS_P.PivotTables(PivotName6).ChangePivotCache (PivotCacheName)
'Refresh Pivot Tables
'Turn on auto calc while pivot's update
Application.Calculation = xlCalculationAutomatic
WS_P.PivotTables(PivotName1).RefreshTable
WS_P.PivotTables(PivotName2).RefreshTable
WS_P.PivotTables(PivotName3).RefreshTable
WS_P.PivotTables(PivotName4).RefreshTable
WS_P.PivotTables(PivotName5).RefreshTable
WS_P.PivotTables(PivotName6).RefreshTable
'Completion Confirmation
MsgBox "Report data has been compiled and pivot tables have been successfully refreshed.", vbInformation, "SUCCESS! - Report Compilation Complete"
'############## End Sub and Reset Application Configuration ##############
'Standard End Sub Functionality (where no undocumented error occurred)
EndSub:
Application.ScreenUpdating = False
Application.Calculation = OriginalCalcMode 'Reset calc option to what it was previously
Application.EnableEvents = True
Exit Sub
'Error Handling (where an undocumented error occurred - that is, an error without an explainatory message box)
ErrorHandler:
Application.ScreenUpdating = False
' Application.Calculation = OriginalCalcMode
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
MsgBox "An error caused this subroutine to stop working correctly." & vbNewLine _
& "Contact Administrator for assistance.", vbCritical, "ERROR - Contact Administrator"
End Sub
I was previously using this and still am for some tables I don't want using the same PivotCache:
'Create new caches for each table
WS_P.PivotTables(PivotName1).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
WS_P.PivotTables(PivotName2).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
WS_P.PivotTables(PivotName3).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
WS_P.PivotTables(PivotName4).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
WS_P.PivotTables(PivotName5).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
WS_P.PivotTables(PivotName6).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
I'm currently getting the Runtime 438 Error (Object doesn't support this property or method) here >>>
WS_P.PivotTables(PivotName1).ChangePivotCache (PivotCacheName)
EDIT: I have found a solution and added an answer below.
So, after a good nights sleep and several more hours of research, I have what I believe to be a solution.
It's probably not the best way, but it works and hasn't yet caused me any issues...
'Create New Pivot Cache from Data Range
WS_P.PivotTables(PivotName1).ChangePivotCache _
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=PivotRange)
'Link Other Pivot Tables to same Pivot Cache
WS_P.PivotTables(PivotName2).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
WS_P.PivotTables(PivotName3).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
WS_P.PivotTables(PivotName4).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
WS_P.PivotTables(PivotName5).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
WS_P.PivotTables(PivotName6).CacheIndex = WS_P.PivotTables(PivotName1).CacheIndex
I'm still not sure why the other way wasn't working so would still appreciate some feedback, if anyone has any as this method does prohibit me attaching slicers to all pivot tables (I have to leave the first one out).

VBA: How to choose files from a folder based on a precondition loop in same sub?

I am very new to VBA and I am trying to automate a dashboard process for my team. The dashboard takes two raw data files, I call these raw data and OP. I created a sheet with macro where I paste the raw data and run the macro by help of button. It filters data based on column 'Market', and there are some 14 markets, start the loop and repeat for all 14. So raw data is one big file with all markets and OP are 14 specific to markets, these are too heavy files.
What I am trying to do is to pick the OP file from the folder for same market as that which the loop picking in raw data file. So trying to get 14 output files for each market.
I looked everywhere no solution. Any help will be a great help.
'Initialize Values
Dim wb_RawData As String
Dim wb_MasterData As String
Dim wb_Control As String
Dim wb_OP As String
Dim Tempsheet As String
Dim MarketArray As Variant
Dim MarketColumn As Integer
Dim Lastrow As Long
Dim ArrayLength As Integer
Dim Workbook As String
Dim StartTime As Double
Dim EndTime As Double
'Loop start time
StartTime = Now
wb_RawData = "RawData"
wb_MasterData = "MasterData"
wb_Control = "Control"
wb_OP = "OP"
MarketColumn = 5
Workbook = Sheets(wb_MasterData).Cells(22, 4)
Sheets(wb_RawData).Activate
Sheets(wb_RawData).Cells(104, MarketColumn).Select
Selection.End(xlUp).Select
Lastrow = ActiveCell.row
Sheets(wb_RawData).Range(Cells(2, MarketColumn), Cells(Lastrow, MarketColumn)).Select
If Not Selection Is Nothing Then
For Each Cell In Selection
If (Cell <> "") And (InStr(Temp_Value, Cell) = 0) Then
Temp_Value = Temp_Vaue & Cell & "|"
End If
Next Cell
End If
If Len(Temp_Value) > 0 Then Temp_Value = left(Temp_Value, Len(Temp_Value) - 1)
MarketArray = Split(Temp_Value, "|")
'Loop through every MarketCode
ArrayLength = UBound(MarketArray)
Application.ScreenUpdating = False
And then it copy and past the raw data into raw data sheet.
The below code is manually picking the OP file, and copy pasting in the main dashboard. But I want to automate this process.
'opening the raw data order profile dashboard
Workbooks.Open Filename:=Path & FIE_OP_RawData
'selecting the section
Range("A1:I1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'pasting in new dashboard
Windows(FIE_Model_Dashboard).Activate
Sheets(OrderProfiles_Sheet_NewDashboard).Select
Range("a1").Select
ActiveSheet.Paste
'Save Dashboard
ChDir _
Location_folder
ActiveWorkbook.SaveAs Filename:= _
Location_folder & "Dashboard - Market " & MarketArray(i) & " - " &
Run_Period & ".xlsb" _
, FileFormat:=xlExcel12, CreateBackup:=False
'Close Dashboard
ActiveWindow.Close
I wish to select same market specific OP file from folder that the loop picked from the raw data.

Find un-open workbook and print from specified sheet

I am creating a spreadsheet which links my customers to their regular orders.
For example: John Smith has eight different orders. So I have one workbook for John Smith and eight sheets within the workbook (one for each order). It needs to be like this because the orders are lengthy and require simple editing.
The spreadsheet in construction has a drop down list for the customers (B3), a drop down list for orders (F3) and a print button (Button10). Therefore you select a customer, select an order and hit print. I want this to then go to the directory (C:\Users\Julian\Documents\Customers), find the correct workbook and sheet, then go to print preview mode of the correct order.
I have very average VBA knowledge (I know how to make a button print preview the current worksheet, but that’s about it). I already have a cell which automatically shows the workbook name (T6) in the right format and automatically shows the worksheet name (T7) in the right format based on drop down selections.
I was wondering if someone could help me with some code to print the correct sheet from the correct workbook based on the drop down selections. If it can’t find the workbook or sheet, I wanted a pop-up message that says “There is no workbook or sheet under this search criteria” or something along those lines instead of a generic coding error.
Any help would be appreciated! Thank you!
Julian.
This is my first answer on Stack Overflow so please bear with me.
I work with databases for a living and I believe there is always a way to make things simpler, especially when you're using Excel, and even more so when you're open to using VBA. I suggest you upload a sample John Smith file and I can show you how to set up a more efficient way for what you're trying to do.
If you just need a quick answer, try the following suggestions.
Error Trapping When Workbook Does Not Exist
'Open the VBA Editor (Alt+F11) and create a new Module and paste the following code in:
Sub PrintOrder()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'-----------'
' VARIABLES '
'-----------'
Dim wb As Workbook, _
ws As Worksheet, _
wb_Client As Workbook, _
ws_Order As Worksheet, _
blOrder As Boolean, _
filDir As String, _
client As String, _
order As String, _
sht As Worksheet, _
xtsn As String
Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1")
'Insert your actual sheet name in place of "Sheet1" or use the worksheet number such as wb.Worksheets(1)
filDir = "C:\Users\Julian\Documents\Customers\"
ChDrive "C"
ChDir filDir
client = Trim(LTrim(ws.Range("T6").Value))
order = Trim(LTrim(ws.Range("T7").Value))
xtsn = ".xlsx" 'Replace the extension below with whatever format your file is in or simply use xtsn = "" if you've already included the file extension in the T6 cell
'---------------------------------'
' CHECK IF CLIENT WORKBOOK EXISTS '
'---------------------------------'
If Dir(client & xtsn) <> "" Then 'the workbook exists so open it
Workbooks.Open Filename:=filDir & client & xtsn
Set wb_Client = ActiveWorkbook
'---------------------------------'
' CHECK IS ORDER WORKSHEET EXISTS '
'---------------------------------'
blOrder = False
For Each sht In Worksheets
If sht.Name = order Then
blOrder = True
Exit For
End If
Next
If blOrder Then 'worksheet exists so open its print preview window
'EDIT// I originally set ws_Order to wb.Worksheets(order) but the proper workbook should be the customer workbook that just opened
Set ws_Order = wb_Client.Worksheets(order)
ws_Order.PrintPreview
Else 'worksheet does not exist so throw into error
'//EDIT// I forgot the ampersand before the 'customer' string variable, which ruined the concatenation
Call MsgBox(prompt:="Order No. " & order & " has not been created for " & customer & "." & _
Chr(13) & "Please create a new order worksheet before continuing." & _
Chr(13) & Chr(13) & " Error Code: A002", _
Buttons:=vbOkOnly, Title:="ERROR: Missing Order Worksheet")
GoTo endProc
End If
Else 'workbook does not exist so throw into error
Call MsgBox(prompt:="No client workbook was found for " & customer & "." & _
Chr(13) & "Please create a new client workbook before continuing." & _
Chr(13) & Chr(13) & " Error Code: A001", _
Buttons:=vbOkOnly, Title:="ERROR: Missing Client Workbook")
GoTo endProc
End If
endProc:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Merge multiple PivotTables for multiple workbooks to create a master PivotTable

I've found a code that I've (mostly) successfully modified for my use, but am getting an error on the grouping function. I have a folder that has (at present) three workbooks in them. Each workbook is formatted exactly the same from sheet names to fields within each sheet. Each workbook has two PivotTables derived from the same unique data source (a third sheet in the workbook).
I need to be able to, in a new workbook, run a script that will allow me to choose the workbooks from the common folder that I want to combine into one master pivot table. My source data looks like this:
(slashes used after the names for each column and after the data in row 2 are only there to differentiate the different columns (12 in total, A to L inclusive))
Row 1 - Line / Sort / Sub-Cat / Part / Para / Page / Deliv / Action / Owner / DueDate / Status / DateComp
Row 2 - 2 / b / Confrnc / 2 / 2.2.1 / 8 / Attend / Attend / John / 23-May-13 / NotStarted / (blank)
Each workbook has a data source sheet set up exactly like this, with multiple rows of data.
Each workbook has a pivot table that compiles:
ROWS:
Sub-Cat;
Action;
Owner;
Status
COLUMNS:
DueDate
VALUES:
Count of Action
I have the following piece of code that I have modified to meet my needs copied and pasted into a new Module in a new workbook (saved in the same folder as my source workbooks):
Option Explicit
Declare Function SetCurrentDirectoryA Lib "kernel32" (ByVal Path As String) As Long
'---------------------------------------------------------------------------------------
' Author: Rob Bovey
'---------------------------------------------------------------------------------------
Sub ChDirNet(Path As String)
Dim Result As Long
Result = SetCurrentDirectoryA(Path)
If Result = 0 Then Err.Raise vbObjectError + 1, "Error changing to new path."
End Sub
'---------------------------------------------------------------------------------------
' Procedure : MergeFiles
' Author : KL
' Date : 22/08/2010
' Purpose : Demonstration (http://www.planetaexcel.ru/forum.php?thread_id=18518)
' Comments : Special thanks to
' Debra Dalgleish for helping to fix ODBC driver issue
' Hector Miguel Orozco Diaz for the "DeleteConnections_12" idea
'---------------------------------------------------------------------------------------
'
Sub MergeFiles()
Dim PT As PivotTable
Dim PC As PivotCache
Dim arrFiles As Variant
Dim strSheet As String
Dim strPath As String
Dim strSQL As String
Dim strCon As String
Dim rng As Range
Dim i As Long
strPath = CurDir
ChDirNet ThisWorkbook.Path
arrFiles = Application.GetOpenFilename("Excel Workbooks (*.xlsx), *.xlsx", , , , True)
strSheet = "Deliverables"
If Not IsArray(arrFiles) Then Exit Sub
Application.ScreenUpdating = False
If Val(Application.Version) > 11 Then DeleteConnections_12
Set rng = ThisWorkbook.Sheets(1).Cells
rng.Clear
For i = 1 To UBound(arrFiles)
If strSQL = "" Then
strSQL = "SELECT * FROM [" & strSheet & "$]"
Else
strSQL = strSQL & " UNION ALL SELECT * FROM `" & arrFiles(i) & "`.[" & strSheet & "$]"
End If
Next i
strCon = _
"ODBC;" & _
"DSN=Excel Files;" & _
"DBQ=" & arrFiles(1) & ";" & _
"DefaultDir=" & "" & ";" & _
"DriverId=790;" & _
"MaxBufferSize=2048;" & _
"PageTimeout=5"
Set PC = ThisWorkbook.PivotCaches.Add(SourceType:=xlExternal)
With PC
.Connection = strCon
.CommandType = xlCmdSql
.CommandText = strSQL
Set PT = .CreatePivotTable(TableDestination:=rng(6, 1))
End With
With PT
With .PivotFields(1) 'Sub Category
.Orientation = xlRowField
.Position = 1
End With
.AddDataField .PivotFields(8), "DueDate", xlCount 'Action Required
With .PivotFields(1) 'Action Required
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields(1) 'Owner
.Orientation = xlRowField
.Position = 1
End With
With .PivotFields(2) 'Status
.Orientation = xlRowField
.Position = 1
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, False)
End With
End With
'Clean up
Set PT = Nothing
Set PC = Nothing
ChDirNet strPath
Application.ScreenUpdating = True
End Sub
Private Sub DeleteConnections_12()
' This line won't work and wouldn't be necessary
' in the versions older than 2007
'*****************************************************************************
On Error Resume Next: ThisWorkbook.Connections(1).Delete: On Error GoTo 0
'*****************************************************************************
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
End Sub
When I run the script, I get to Line 92, where I get a run-time error 1004: Cannot group that selection.
.DataRange.Cells(1).Group _
Start:=True, _
End:=True, _
Periods:=Array(False, False, False, False, True, False, False)
For the life of me, I'm lost and cannot find anything anywhere to fix this.
Can anyone make any recommendations or suggestions?
I am still very new at VBA, but not with PivotTables. I am trying to avoid having to manually compile all of the data from the source workbooks into a master and running the PivotTable from there, because the workbooks are owned by three different users and are updated regularly. I am utilizing an OFFSET formula to name my source data range, and using this as my data source for my PivotTables so they all update at once, and the formula automatically increases the range to include any new rows or columns that have been added to the source data sheet.
I also recognize that just because it works up to the grouping point, that doesn't mean that the variables for the PivotFields are done correctly either - so if someone sees something there too - I'm open to hearing about it!
I am working in Excel 2013 and 2010.
Transfer from Question what appears to be an answer, or as near as likely to be achieved:
Here are screen shots of both my data set of what my pivot tables look like derived from each individual workbook's data set, and how I want it to look by running the script:
Looking at #KazJaw comments, I've researched the Range.Group and looked at the Periods portion. I ended up deleting it completely and ran the script without a problem! Have to manually adjust the Field Lists and formatting, but that's the easy part compared with pulling the actual data as it is always and ever changing.

Resources