How to define PIVOT table source dynamically? - vba

I'm trying to do a PIVOT table from different worksheets and insert each PIVOT output in a certain column into a table.
Sub PivotvpcodeSATURATION()
Dim wsNew As Worksheet
Dim i As Integer
Dim z As Integer
Set ws1 = ActiveWorkbook.Sheets("24.11.")
Set ws2 = ActiveWorkbook.Sheets("25.11.")
Set ws3 = ActiveWorkbook.Sheets("26.11.")
Set ws4 = ActiveWorkbook.Sheets("27.11.")
Set ws5 = ActiveWorkbook.Sheets("28.11.")
Set ws6 = ActiveWorkbook.Sheets("29.11.")
Set ws7 = ActiveWorkbook.Sheets("30.11.")
Set wsNew = Sheets.Add
i = 3
z = 16
Do
ws1.Select
Range("A2").Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"24.11.!R1C2:R11754C10", Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=wsNew.Name & "!R3C1", TableName:="PivotTable", DefaultVersion _
:=xlPivotTableVersion14
wsNew.Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable").PivotFields("VP CODE")
.Orientation = xlRowField
.Position = 1
End With
wsNew.Select
ActiveSheet.PivotTables("PivotTable").AddDataField ActiveSheet.PivotTables( _
"PivotTable").PivotFields("1/0"), "Sum of 1/0", xlSum
wsNew.Select
Range("B4").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("VP_Saturation").Select
' Range(Cells(3, z).Address).Select
ActiveSheet.Paste
Application.DisplayAlerts = False
wsNew.Delete
Application.DisplayAlerts = True
z = z + 2
Loop Until z = 28
End Sub
The thing i am non able to reach is,
how to define a worksheets name as a variable, so that i don't have to select w1, w2,w.., wn each time, and don't have to put a sheet name inside 24.11.!R1C2:R11754C10 .
As well the column name where to insert copied Pivot result i define as a variable Cells(3, z).Address.Select, but this string returns an error.
Maybe someone can help with it? Thanks!

put all worksheets in an array and do a cycle on each element of the array with For Each....Next
regarding your second question, change:
SourceData:="24.11.!R1C2:R11754C10"
to
SourceData:=ws1.name&"!R1C2:R11754C10"
and it will feed the worksheet name into the string
third question:
replace
Range(Cells(3, z).Address).Select
with
Cells(3, z).Select

If you use a template Excel file where the format doesn't change. I suggest creating a dynamic named range for all your data sources. Then just go to each pivot table and refer to the named range in Change Source Pivot Table Options.
All your VBA has to do is a variation of ThisWorkbook.RefreshAll.
Use a variation of this formula to create the dynamic named range: =Data!$A$5:OFFSET(Data!$A$5,COUNTA(Data!$A:$A)-1,52). Basically choose the data source sheet, the starting cell, and how many columns over the data sits. The rows will adjust automatically.

Related

copy paste filtered data not working as expected

First things first. I am very new to VBA.
Secondly, I googled my ass of and I honestly don't get to the bottom of it. Mostly because the code is adapted to my needs based on googleing i did (copy/paste of code).
To my problem. I have a sheet(Raw Data) with lots of columns(A:AN) and lots of rows(160000) that gets updated every now and then. I want to filter the dataset based on the criteria from a few columns(A & B), and the copy/paste the data in a different sheet(Scatter Raw) starting from column A. I also do not want to copy the header from "Raw Data" and start pasting in "Scatter Sheet" also below the header -> in this case 2 rows.
I have two issues for now:
Based on the filters I do, I will get 17267 rows in "Raw Data". If I simply do a select and copy then I copy only the filtered data. But the moment I paste the data somehow I suddenly get 18362 rows, even though they are empty. I can see this by the fact that the scroll bar goes down. I used this way of copying because sometimes I want to be able to append the copied data based on value set in a different cell. What am I doing here wrong, or what is happening?
I have more sheets inside the workbook. If I do not have the Raw Data worksheet selected I get an error like "Application-defined or object-defined error" on the "Set rng = " line which I don't get. In other test I also got a different error, but that was because the Range was based on the active sheet and not the one I needed. Why is this happening, since the filters are correctly set?
The values from column N should all be divided by 1000. I guess I have no other way then using a temporary copy column, divide it by 1000 in a new column and then copy/paste the new values to the location I need in, right?
Just one last mention, the code is running in a Module and will be later assigned to a button.
Sub Copy()
Dim destTrSheet As Worksheet
Dim sctrSheet As Worksheet
Set destTrSheet = ThisWorkbook.Worksheets("Data Raw")
Set sctrSheet = ThisWorkbook.Worksheets("Scatter Raw")
With destTrSheet
.Range("A:A").AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
.Range("B:B").AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues
Set Rng = .Range("N2").Resize(Cells(Rows.count, "N").End(xlUp).Row - 1)
Rng.Copy
sctrSheet.Range("A" & Rows.count).End(xlUp).Offset(1, 0).PasteSpecial (xlPasteValues)
Set Rng = .Range("X2").Resize(Cells(Rows.count, "N").End(xlUp).Row - 1)
Rng.Copy
sctrSheet.Range("B" & Rows.count).End(xlUp).Offset(2, 0).PasteSpecial (xlPasteValues)
End With
End Sub
The issues you mentioned
Discrepancy between manual copy and code copy could be caused by the offsets used:
Col A .Offset(1, 0).PasteSpecial - 1 row below last used row
Col B .Offset(2, 0).PasteSpecial - 2 rows below last used row
The error is caused by .Range("N2") vs (Cells(Rows.count, "N")
.Range("N2") is explicitly qualified because of the dot (.) - refers to "Data Raw"
Cells(Rows.count, "N") is implicitly referring to ActiveSheet (missing .)
If column N should be divided by 1000
Yes, a helper column can be used, as in the code bellow
Another way: copy the column to an array, divide each value, then paste it back
If column N contains strings, the division will generate cell errors:
Option Explicit
Public Sub CopyRawToScatter()
Dim wsR As Worksheet: Set wsR = ThisWorkbook.Worksheets("Data Raw")
Dim wsS As Worksheet: Set wsS = ThisWorkbook.Worksheets("Scatter Raw")
Dim lrR As Long: lrR = wsR.Cells(wsR.Rows.Count, "A").End(xlUp).Row
Dim lrS As Long: lrS = wsS.Cells(wsS.Rows.Count, "A").End(xlUp).Row + 1
With wsR
Dim fRng As Range: Set fRng = .Range(.Cells(1, "A"), .Cells(lrR, "B"))
Dim rngN As Range: Set rngN = .Range(.Cells(2, "N"), .Cells(lrR, "N"))
Dim rngX As Range: Set rngX = .Range(.Cells(2, "X"), .Cells(lrR, "X"))
Dim cRng As Range: Set cRng = Union(rngN, rngX)
End With
Application.ScreenUpdating = False
fRng.AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
fRng.AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues
If fRng.SpecialCells(xlCellTypeVisible).CountLarge > 2 Then
cRng.Copy
wsS.Cells(lrS, "A").PasteSpecial xlPasteValues
With wsS
Dim vis As Long: vis = .Cells(.Rows.Count, "A").End(xlUp).Row
Dim lcS As Long: lcS = .Cells(lrS, "A").End(xlToRight).Column + 1
Dim divA As Range: Set divA = .Range(.Cells(lrS, "A"), .Cells(vis, "A"))
Dim divX As Range: Set divX = .Range(.Cells(lrS, lcS), .Cells(vis, lcS))
divX.Formula = "=" & .Cells(lrS, 1).Address(RowAbsolute:=False) & " / 1000"
divA.Value2 = divX.Value2
divX.ClearContents
End With
End If
wsR.UsedRange.AutoFilter
Application.ScreenUpdating = False
End Sub
Other issues
Potential conflict between your Sub name (Copy()) with the built-in Range.Copy Method
The 2 AutoFilter lines are invalid
.Range("A:A").AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
.Range("B:B").AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues
If your code works you probably modified it when posting the question; they should be
.Range("A:B").AutoFilter field:=1, Criteria1:="VF", Operator:=xlFilterValues
.Range("A:B").AutoFilter field:=2, Criteria1:="CITY", Operator:=xlFilterValues
You don't need brackets for .PasteSpecial (xlPasteValues)

Combine Print Ranges from Multiple Worksheets VBA EXCEL

I am trying to figure out how to print the "ActiveSheet" or Sheet1 along with "Sheet5" (rows 1-6, A:M) being displayed at the bottom with a 2 row space in between the end of Sheet1 and the beginning of data from Sheet5. I've been trying to look up similar questions and read something about a "Union" but I wasn't sure how it would fit here.
Private Sub CommandButton1_Click()
Dim Sel_Manager As String
'Headers repeated at the top
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$2:$2"
.PrintTitleColumns = "$B:$M"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'Manager selection through ComboBox dropdown
Sel_Manager = ComboBox1
'Inserting autofilters for worksheet
Cells.Select
Selection.AutoFilter
'Manager defined in the dropdown ComboBox
ActiveSheet.Range("B2", Range("M2").End(xlDown)).AutoFilter Field:=1, Criteria1:=Sel_Manager
ActiveSheet.Range("B2", Range("M2").End(xlDown)).AutoFilter Field:=2, Criteria1:="A"
'Here I select range to be printed and specify manager in filename
ActiveSheet.Range("B2", Range("M2").End(xlDown)).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Sel_Manager + ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveSheet.ShowAllData
Application.PrintCommunication = True
End Sub
This may give you some ideas.
I created two worksheets. One, called "Main", contains data that has "names" in column B and some As in column C. The other, called "Extra" contains the six rows to appear at the bottom of the filtered data.
I do not use Excel's identifiers when referencing worksheets. The first sheet will have an identifier of Sheet1 and a name of "Sheet1". If you immediately create another sheet it will have an identifier of Sheet2 and a name of "Sheet2". However, if Sheet1 is renamed before the second sheet is created, it will have an identifier of Sheet2 and a name of "Sheet1". It can all get very confusing.
I have hardcoded the selected manager as "Aaaaa" rather than make it a user entered parameter. I have prepared worksheet "Main" for printing but have not output it.
Option Explicit
Sub Test()
Dim Manager As String
Dim RngFiltered As Range
Dim RowSht1Last As Long
Manager = "Aaaaa"
With Worksheets("Main")
.AutoFilterMode = False ' Switch off auto filtering if on
' Find last row containing a value
RowSht1Last = .Cells.Find("*", .Range("A1"), xlFormulas, , xlByRows, xlPrevious).Row
With .Range("B2:M2")
.AutoFilter Field:=1, Criteria1:=Manager
.AutoFilter Field:=2, Criteria1:="A"
End With
Set RngFiltered = .Cells.SpecialCells(xlCellTypeVisible)
' Just to show the filtered range. Note, I cannot find a documented limit
' on the number of sub-ranges within a range. If there is a limit, I have
' never managed to reach it. However Range.Address has a limit which is a
' little under 255.
Debug.Print Replace(RngFiltered.Address, "$", "")
Worksheets("Extra").Range("A1:M6").Copy Destination:=.Cells(RowSht1Last + 2, "A")
' ###### Output visible rows
' Delete rows copied from Sheet5
.Rows(RowSht1Last + 2 & ":" & RowSht1Last + 8).Delete
End With
End Sub

Excel to Access import false columns

I'm dealing with a lot of historical data and I made a macro to format these excel spreadsheets into an Access friendly information. However I'm having issues when importing these excel files into Access. No matter what I code into the VBA, Access still believes there are about 30 blank columns after the first four of actual data. The only way to prevent this is to manually go in and delete the columns. For some reason my VBA code just won't prevent it. I'm dealing with a lot of spreadsheets, so it's going to take considerable time to manually delete these columns. My code is below; any ideas on how I could make Access interpret these correctly?
Public CU_Name As String
Sub RegulatorFormat()
Dim wks As Worksheet
Dim wks2 As Worksheet
Dim iCol As Long
Dim lastRow As Long
Dim Desc As Range
Dim lastCol As Long
Application.ScreenUpdating = False
Worksheets.Select
Cells.Select
Selection.ClearFormats
Call FormulaBeGone
ActiveSheet.Cells.Unmerge
CU_Name = [B1].Value
lastRow = Range("C" & Rows.Count).End(xlUp).Row
Set Desc = Range("A1", "A57")
Desc.Select
For Each wks In ActiveWindow.SelectedSheets
With wks
On Error Resume Next
For iCol = 16 To 4 Step -1
Dim PerCol As Date
PerCol = Cells(1, iCol)
.Columns(iCol).Insert
Range(Cells(1, iCol), Cells(lastRow, iCol)) = CU_Name
.Columns(iCol).Insert
Range(Cells(1, iCol), Cells(lastRow, iCol)) = Desc.Value
.Columns(iCol).Insert
Cells(1, iCol).Value = PerCol
Range(Cells(1, iCol), Cells(lastRow, iCol)) = Cells(1, iCol)
Range(Cells(1, iCol), Cells(lastRow, iCol)).NumberFormat = "mm/dd/yyyy"
Next iCol
End With
Next wks
Rows("1:2").EntireRow.Delete
Columns("A:C").EntireColumn.Delete
lastCol = ws.Cells.Find(What:="*", _
After:=ws.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
For Each wks2 In ActiveWindow.SelectedSheets
With wks2
On Error Resume Next
For iCol = 52 To 6 Step -4
lastRow = Range("C" & Rows.Count).End(xlUp).Row
Set CutRange = Range(Cells(1, iCol), Cells(54, iCol - 3))
CutRange.Select
Selection.Cut
Range("A" & lastRow + 1).Select
ActiveSheet.Paste
Next iCol
End With
Next wks2
Columns("E:ZZ").Select
Selection.EntireColumn.Delete
Application.ScreenUpdating = True
Rows("1").Insert
[A1] = "Period"
[B1] = "Line#"
[C1] = "CU_Name"
[D1] = "Balance"
Columns("E:BM").Select
Selection.Delete Shift:=xlToLeft
Call Save
End Sub
Sub FormulaBeGone()
Worksheets.Select
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Select
Application.CutCopyMode = False
End Sub
Sub Save()
Dim newFile As String
newFile = CU_Name
ChDir ("W:\ALM\Statistics\MO Automation\2015")
'Save folder
ActiveWorkbook.SaveAs Filename:=newFile
'Later should seperate CU's into folder by province and year
End Sub
Access is importing the 'used range' as a table, and that's not quite the same as 'all the cells with data'.
The 'UsedRange' property picks up empty strings, formatting and (sometimes) live selections and named ranges...
...And it sometimes picks up an oversize used range for no reason anyone outside Redmond will ever know.
So your next job is to redefine the phrase 'Access-Friendly'
The most 'Access-Friendly' method of all is to export csv files - you may hear opinions to the contrary, but not from anyone who's done it often enough to encounter the memory leak in the JET OLEDB 4 Excel driver.
But the easiest way is to specify the range in a linked table or - better still - an ODBC-Connected SQL Query:
SELECT *
FROM [Sheet1$D3:E24]
IN "" [Excel 8.0;HDR=YES;IMEX=0;DATABASE=C:\Temp\Portfolio.xls];
Note the format for specifying a sheet and range: '$', not '!' to separate the sheet name and the address. You could use Sheet$, but you're back to the whole guess-the-used-range thing.
Note that I've said there's a header row, cells D3:E3, listing the field names 'HDR=YES'. You don't have to, but I do recommend it: calling columns by name is easier for the database engine.
Note that I've also specified 'IMEX=0', which ought to mean 'don't guess the field types, they are all text' but the JET database drivers treat it with cavalier disregard. So import this into a table with text columns and do your data type and format work in a subsequent MS-Access query on those text fields.
Those two quote marks after 'IN' ? Don't ask.
And I'm using an '.xls' file, Excel version 8.0. Look up ConnectionStrings.com for later versions, or build a linkled table in MS-Access to the type of file you want, and interrogate the Tabledef.Connect property.
It will have occurred to you by now that you can dynamically construct the query, supplying file names and sheet names for successive imports from a vast folder of spreadsheets; so here's the final piece of SQL, and the reason for specifying field names:
JET SQL for inserting rows directly into an MS-Access table from an Excel range:
INSERT INTO Table1 (Name, PX_Last, USD, Shares)
SELECT *
FROM [Sheet1$D3:E24]
IN "" [Excel 8.0;HDR=YES;IMEX=0;DATABASE=C:\Temp\Portfolio.xls];
This will run in the MS-Access database: don't try to execute it from an ADODB connection inside the spreadsheet files you're exporting.

How to combine reverse-chronological sheets while rearranging cells, preventing stacking?

OK, I will try to explain this well. An odd problem to solve, and it's WAY beyond my skill level (novice).
Excel 2011 for Mac.
The workbook has 11 sheets.
Sheet names are all 'Month Year'. (Eg: sheet 1 is titled "June 2013")
Sheet names are reverse chronological. (June 2013, May 2013, April 2013 etc)
Each sheet has data in the same layout:
A1 is the sheet's name. B1 through to a varying endpoint on B hold dates. (approx two weeks but varies greatly between sheets)
A2 and downward in A is all names, as "last,first".
The remaining columns below B1 and outward are either blank, 0's, or 1's (attendance for date at row 1).
What I need to do:
Get ALL of the data in one sheet, with dates in chronological order along row 1 and names in alphabetical order down column A. Without messing up the associations between the names and the 0/1/blank values that existed on the original sheet.
What I have done:
I did this manually using the Excel GUI on a very similar sheet. It took forever!
I also have been writing or sourcing Subs to do some of the other work needed to these sheets to get them ready for this big rearranging. But I am already at my limits writing super simple "find rows with the word 'total' in them" sorts of stuff.
I know WHAT to do here, but have no clue HOW.
Start with the oldest sheet, copy into a new sheet(YearSheet).
Take names from 2ndOldest, paste into A under names already there.
Take dates and the cells beneath them into YearSheet, but staggered out on the columns so they begin where the first sheet left off.
Repeat again with nextYoungest, same deal. Names under names, dates and data shoved out along the letter axis to prevent overlap with prior dates.
Eventually it's a long list of names in A, and a descending step-pattern of data blocks in the remainder.
Sort it all by A, alphabetically.
Find and compress identical names into one row, without losing the data along the way (Why does Excel only keep top left? Aaargh!)
So, I know that's a lot to ask here.
Have no idea if this is too much or over the top for a question, but I am just stumped so am posting it in hopes somebody can make sense of the VBA to do it.
I created a workbook based on your description to use as sample data.
I wrote this macro
Sub Main()
Dim CombinedData As Variant
Dim TotalCols As Integer
Dim TotalRows As Long
Dim PasteCol As Integer
Dim PasteRow As Long
Dim i As Integer
Dim PivSheet As Worksheet
ThisWorkbook.Sheets.Add Sheet1
On Error GoTo SheetExists
ActiveSheet.Name = "Combined"
On Error GoTo 0
Range("A1").Value = "Name"
For i = ThisWorkbook.Sheets.Count To 1 Step -1
If Sheets(i).Name <> "Combined" Then
Sheets(i).Select
TotalCols = Sheets(i).Columns(Columns.Count).End(xlToLeft).Column
TotalRows = Sheets(i).Rows(Rows.Count).End(xlUp).Row
PasteCol = PasteCol + TotalCols - 1
If PasteRow = 0 Then
PasteRow = 2
Else
PasteRow = PasteRow + TotalRows - 1
End If
'Copy Date Headers
Range(Cells(1, 2), Cells(1, TotalCols)).Copy Destination:=Sheets("Combined").Cells(1, PasteCol)
'Copy Names
Range(Cells(2, 1), Cells(TotalRows, 1)).Copy Destination:=Sheets("Combined").Cells(PasteRow, 1)
'Copy Data
Range(Cells(2, 2), Cells(TotalRows, TotalCols)).Copy Destination:=Sheets("Combined").Cells(PasteRow, PasteCol)
End If
Next
Sheets("Combined").Select
ActiveSheet.Columns.AutoFit
With ActiveSheet.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortNormal
.SetRange ActiveSheet.UsedRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Set PivSheet = Sheets.Add
ThisWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=Sheets("Combined").UsedRange, _
Version:=xlPivotTableVersion14).CreatePivotTable _
TableDestination:=PivSheet.Range("A1"), _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion14
For i = 1 To PivSheet.PivotTables("PivotTable1").PivotFields.Count
With ActiveSheet.PivotTables("PivotTable1")
If i = 1 Then
.PivotFields(i).Orientation = xlRowField
.PivotFields(i).Position = 1
Else
ActiveSheet.PivotTables("PivotTable1").AddDataField .PivotFields(i), _
"Sum of " & .PivotFields(i).Name, _
xlSum
End If
End With
Next
Application.DisplayAlerts = False
Sheets("Combined").Delete
Application.DisplayAlerts = True
PivSheet.Name = "Combined"
CombinedData = ActiveSheet.UsedRange
Cells.Delete
Range(Cells(1, 1), Cells(UBound(CombinedData), UBound(CombinedData, 2))).Value = CombinedData
Range("A1").Value = "Name"
Range(Cells(1, 1), Cells(1, UBound(CombinedData, 2))).Replace "Sum of ", ""
Columns.AutoFit
Exit Sub
SheetExists:
Application.DisplayAlerts = False
Sheets("Combined").Delete
Application.DisplayAlerts = True
Resume
End Sub
Which produces this result:
This was written in Excel 2010 in windows. I don't know what the differences are between the pc and mac versions but this may work for you.

VBA; Invalid procedure or argument error

A little background;
I have to run a weekly reports for my job on Monday for the previous week, however I need to consolidated the material, I did and made a pivot table and I have to do this for multiple worksheets. However I decided to create a macro to do this redundant task. Created it now I seem get this error message "Invalid Procedure or Argument". I can't get it to open in my in a new work sheet, t his is my code >>
Sub weekmaster()
'
' weekmaster Macro
' Macro for the week
'
' Keyboard Shortcut: Ctrl+t
'
Cells.Select
Sheets.Add
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"weekmaster!R1C1:R1048576C62", Version:=xlPivotTableVersion12). _
CreatePivotTable TableDestination:="Sheet9!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion12
Sheets("Sheet9").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1").PivotFields("Order ID")
.Orientation = xlRowField
.Position = 1
End With
It appears you're missing one argument. CreatePivotTable takes the following arguments:
expression.CreatePivotTable(TableDestination, TableName, ReadData, DefaultVersion)
TableDestination Required Variant The cell in the upper-left corner of the PivotTable report’s destination range (the range on the worksheet where the resulting PivotTable report will be placed). The destination range must be on a worksheet in the workbook that contains the PivotCache object specified by expression.
TableName Optional Variant The name of the new PivotTable report.
ReadData Optional Variant True to create a PivotTable cache that contains all of the records from the external database; this cache can be very large. False to enable setting some of the fields as server-based page fields before the data is actually read.
DefaultVersion Optional Variant The default version of the PivotTable report.
Subsequently, you'll probably want to add 'true' between your TableName and DefaultVersion.
Cheers, LC
You'll get an error if you run the macro more than once, or if Sheet9 already exists (because the macro tries to create the same pivot table with the same name on the same sheet). If I am to assume that you a new PivotTable in a new worksheet to be generated every time you go to your data sheet and run the macro, you can update your code with the following:
Dim myRange as Range
dim myNewSheet as Worksheet
' Stores all continuous data on the sheet in the myRange variable
Set myRange = Range("A1").CurrentRegion
' Adds a new sheet and stores it in the myNewSheet variable
Set myNewSheet = Sheets.Add
' Use the variables to create the new pivot table
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
myRange, Version:=xlPivotTableVersion12).CreatePivotTable _
TableDestination:=myNewSheet.Cells(3, 1), DefaultVersion _
:=xlPivotTableVersion12
' Select your Order ID field
With myNewSheet.PivotTables(1).PivotFields("Order ID")
.Orientation = xlRowField
.Position = 1
End With