Tbalsmeier
New Member
- Joined
- Dec 21, 2017
- Messages
- 2
Hello,
First, my apologize if this is in the wrong area and/or this has already been answered. This is my first time posting and I am relatively inexperienced with VBA.
What I am trying to figure out is how to do the following:
1. Lookup user inputs on the ActiveWorkbook for new workbook name and the name of the range within that workbook
2. Use those inputs, along with the file path (assumed to match the ActiveWorkbook path) to find the new data source
3. Use that path to set up a new PivotCache and replace the old PivotCache
4. Update all the PivotTables in the ActiveWorkbook to the new PivotCache
I had code that would create a new PivotCache for each PivotTable in the workbook. This however, too way to long and would stop because it was storing to much information on my computer cache. My hope is to only have 1 PivotCache in the ActiveWorkbook. FYI, the data file is about 65,000 KB.
Below is the most recent attempt on my part. If there is a simpler way to accomplish what I am trying to do, please let me know.
Sub UpdatePivots()
Dim wks As Worksheet
Dim file_name, range_name, data_source As String
Dim pvcNew As PivotCache
With ActiveWorkbook
file_path = .Path
'Verifies that user input data source in cell I1 & I2
With .Worksheets("Docu")
If .Range("I1") <> "" And .Range("I2") <> "" Then
file_name = .Range("I1")
range_name = .Range("I2")
Else
MsgBox ("Please update cell I1 & I2 with the data source workbook information")
Exit Sub
End If
End With
'Since the user might add the " ' " to the beginning and end of the string
'This checks to see if the reference string is in the correct format
If Left(file_name, 1) = "'" Then
file_name = Right(file_name, Len(file_name) - 1)
End If
If Right(file_name, 1) = "'" Then
file_name = Left(file_name, Len(file_name) - 1)
End If
'Combines all the information into a single string
data_source = "'" & file_path & "" & file_name & "'!" & range_name
'Creates new PivotTable to add another PivotCache to the worksheet and replaces the old PivotCache
Application.DisplayAlerts = False
Set pvcNew = ThisWorkbook.PivotCaches.Add(xlExternal)
Set pvcNew.DataSource = Range(data_source).Address
Set wks = Sheets.Add
pvcNew.CreatePivotTable wks.Range("A3")
shtTrend.PivotTables(1).CacheIndex = pvcNew.Index
wks.Delete
Application.DisplayAlerts = True
'This area will have a two For Each loops; Worksheets and Pivots to cycle through all the PivotTables in the Workbook
'Waiting to Code until PivotCache Issue solved
End With
End Sub
Please let me know if additional information is needed.
Any help is very much appreciated, thanks in advance!
First, my apologize if this is in the wrong area and/or this has already been answered. This is my first time posting and I am relatively inexperienced with VBA.
What I am trying to figure out is how to do the following:
1. Lookup user inputs on the ActiveWorkbook for new workbook name and the name of the range within that workbook
2. Use those inputs, along with the file path (assumed to match the ActiveWorkbook path) to find the new data source
3. Use that path to set up a new PivotCache and replace the old PivotCache
4. Update all the PivotTables in the ActiveWorkbook to the new PivotCache
I had code that would create a new PivotCache for each PivotTable in the workbook. This however, too way to long and would stop because it was storing to much information on my computer cache. My hope is to only have 1 PivotCache in the ActiveWorkbook. FYI, the data file is about 65,000 KB.
Below is the most recent attempt on my part. If there is a simpler way to accomplish what I am trying to do, please let me know.
Sub UpdatePivots()
Dim wks As Worksheet
Dim file_name, range_name, data_source As String
Dim pvcNew As PivotCache
With ActiveWorkbook
file_path = .Path
'Verifies that user input data source in cell I1 & I2
With .Worksheets("Docu")
If .Range("I1") <> "" And .Range("I2") <> "" Then
file_name = .Range("I1")
range_name = .Range("I2")
Else
MsgBox ("Please update cell I1 & I2 with the data source workbook information")
Exit Sub
End If
End With
'Since the user might add the " ' " to the beginning and end of the string
'This checks to see if the reference string is in the correct format
If Left(file_name, 1) = "'" Then
file_name = Right(file_name, Len(file_name) - 1)
End If
If Right(file_name, 1) = "'" Then
file_name = Left(file_name, Len(file_name) - 1)
End If
'Combines all the information into a single string
data_source = "'" & file_path & "" & file_name & "'!" & range_name
'Creates new PivotTable to add another PivotCache to the worksheet and replaces the old PivotCache
Application.DisplayAlerts = False
Set pvcNew = ThisWorkbook.PivotCaches.Add(xlExternal)
Set pvcNew.DataSource = Range(data_source).Address
Set wks = Sheets.Add
pvcNew.CreatePivotTable wks.Range("A3")
shtTrend.PivotTables(1).CacheIndex = pvcNew.Index
wks.Delete
Application.DisplayAlerts = True
'This area will have a two For Each loops; Worksheets and Pivots to cycle through all the PivotTables in the Workbook
'Waiting to Code until PivotCache Issue solved
End With
End Sub
Please let me know if additional information is needed.
Any help is very much appreciated, thanks in advance!