I am trying to create a pivot table from a .csv file. But I am having a run time error 1004: Reference is not valid over at the ActiveWorkbook portion of the code.
Any suggestions for this?
My code is as follows
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
Sheets.Add
ws.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ws.Name & "R1C1:R101643C21", Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet1!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
I did a Sheets.Add to add in new worksheet. I used a ws.Name as the name can be any name. Just an addition question, is it possible to change R1C1:R101643C21 to a varying range as the data may not be that big or small?
Notice the ! in SourceData. The missing ! is causing the invalid reference
Sub test()
Dim ws As Worksheet
Set ws = ActiveSheet
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
ws.Name & "!R1C1:R11C2", Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
For dynamic range, see this
Sub test()
Dim ws As Worksheet
Dim rng As Range
Set ws = ActiveSheet
Set rng = ws.Range("A1:B10")
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
rng, Version:=xlPivotTableVersion10). _
CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1" _
, DefaultVersion:=xlPivotTableVersion10
End Sub
Just a reminder, you are only creating a empty pivot table in this way
Related
I'm trying to write a code that sorts two columns in a worksheet but having difficulties due to there being zeros and blanks.
I need to sort by date (earliest to oldest), then sort the data in terms of premium (largest to smallest but there will be blanks or zero premiums entered).
I'd like the macro to order the sheet so it shows the date (earliest) and then premium (largest) in order.
Here is what I have so far and it's not quite working, please can someone help?
P = date
F = premium values
Range = A2:BA5000 (entries shouldn't exceed this number and it isn't a table)
There will always be something in A3 (this is a policy number, anything entered into the sheet must have a policy number)
The spreadsheet is saved on SharePoint and autosave is on
Sub MultiLevelSort()
Worksheets("Portfolio Tracker").Unprotect Password:="Password"
Worksheets("Portfolio Tracker").Sort.SortFields.Clear
Range("A3", Range("A3").End(xlDown)).Sort Key1:=Range("F3"), Key2:=Range("P3"), Header:=xlYes, _
Order1:=xlAscending, Order2:=xlDescending
Worksheets("Portfolio Tracker").Protect Password:="Password", AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, AllowDeletingRows:=True
End Sub
Any help would be amazing as it's driving me crazy.
Sort a Range
The Before and the After
The Code
Option Explicit
Sub MultiLevelSort()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Worksheets("Portfolio Tracker")
ws.Unprotect Password:="Password"
If ws.AutoFilterMode Then ws.AutoFilterMode = False
Dim lRow As Long: lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim rg As Range: Set rg = ws.Range("A3", ws.Cells(lRow, "BA"))
ws.Sort.SortFields.Clear
rg.Sort Key1:=rg.Columns(6), Order1:=xlAscending, _
Key2:=rg.Columns(16), Order2:=xlDescending, _
Header:=xlNo
ws.Protect Password:="Password", AllowSorting:=True, AllowFiltering:=True, _
AllowUsingPivotTables:=True, DrawingObjects:=True, Scenarios:=False, _
AllowDeletingRows:=True
End Sub
I want to filter unique values form a list and copy paste them to a new sheet. Unfortunately after deleting the new "Tabelle14" to which the filtered data was submitted before ..by doing another conduction with this macro it is impossible because it does not recognize "Tabelle14" anymore. This approach does not work
Sub Makro4()
'
' Makro4 Makro
'
' Tastenkombination: Strg+c
'
Sheets.Add After:=ActiveSheet
Sheets("Tabelle1").Select
Columns("K:K").Select
ActiveSheet.Range("$K$1:$K$15").RemoveDuplicates Columns:=1, Header:=xlNo
Selection.Copy
Sheets("Tabelle14").Select
Columns("H:H").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
This was another approach which works much better just by the fact that i do not delete data from the original sheet. What i can not afford is that the data is submitted to another sheet. I tried with Destination:= instead CopyRange:= but I don't know how to explain the program to submit something to a new unnamed sheet which is not existing. I also tried by doing something with Workbooks.Add and ActiveSheet.Copy After:=Sheets(Sheets.Count)
Sub Unique_Values()
ThisWorkbook.Worksheets("name").Activate
Range("J:J").AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Range("BO:BO"), _
Unique:=True
End Sub
Thanks for your help
Advanced Filter to a New Worksheet
Option Explicit
Sub Unique_Values()
Dim wb As Workbook: Set wb = ThisWorkbook
With wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
.Parent.Worksheets("name").Range("J:J").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=.Range("BO:BO"), _
Unique:=True
End With
End Sub
Sub Unique_Values_Worksheet_Variables()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim sws As Worksheet: Set sws = wb.Worksheets("name")
Dim dws As Worksheet
Set dws = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
sws.Range("J:J").AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=dws.Range("BO:BO"), _
Unique:=True
End Sub
Sub Unique_Values_Range_Variables()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim srg As Range: Set srg = wb.Worksheets("name").Range("J:J")
Dim drg As Range
Set drg = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Range("BO:BO")
srg.AdvancedFilter _
Action:=xlFilterCopy, _
CopyToRange:=drg, _
Unique:=True
End Sub
On the basis of a few posts I was able to make below script which prints several selected ranges to a pdf file. However, all ranges are printed on a seperate sheet.
Currently NewRng.Address="A1:G9,A13:G14,A18:G37". I think it might need to be "A1:G9;A13:G14;A18:G37" (seperated by ; instead of ,)(?)
Can someone explain how can I print the selected ranges on one sheet?
Thank you so much!
Script:
Sub CreatePDF_Selection1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim NewRng As Range
With ThisWorkbook.Sheets("Sheet1")
Set rng1 = .Range("A1:G9")
Set rng2 = .Range("A13:G14")
Set rng3 = .Range("A18:G37")
Set NewRng = .Range(rng1.Address & "," & rng2.Address & "," & rng3.Address)
Debug.Print NewRng.Address
Sheets("Sheet1").Activate
ActiveSheet.Range(NewRng.Address).Select
Sheets(Array("Sheet1")).Select
ThisWorkbook.Sheets(Array("Sheet1")).Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
End With
End Sub
Rather than select various ranges just hide the rows you don't want to print then print the entire range.
Option Explicit
Sub CreatePDF_Selection1()
Dim rng1 As Range
ThisWorkbook.Sheets("Sheet1").Activate
Set rng1 = Range("A1:G37")
Range("A10:A12").EntireRow.Hidden = True '*** Hide rows not to print ***
Range("A15:A17").EntireRow.Hidden = True
rng1.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
Rows("1:37").EntireRow.Hidden = False '*** Unhide hidden rows ***
End Sub 'CreatePDF_Selection1()
HTH
Edit: Attach test output.
I could not find a direct solution, so there is a work about here. A new worksheet will be added. The content will be copied there as a continuous range. The sheet will be exported as PDF, than the not needed sheet will be deleted.
Sub CreatePDF_Selection1()
Dim rng1 As Range, rng2 As Range, rng3 As Range
Dim NewRng As Range
Application.ScreenUpdating = False
With Sheet1
Set rng1 = .Range("A1:G9")
Set rng2 = .Range("A13:G14")
Set rng3 = .Range("A18:G37")
Set NewRng = Union(rng1, rng2, rng3)
End With
'Creating test values
rng1.Value = "Test 1"
rng2.Value = "Test 2"
rng3.Value = "Test 3"
NewRng.Copy
'adding a new sheet
Worksheets.Add after:=Sheet1
With ActiveSheet
.Paste
.ExportAsFixedFormat, _
Type:=xlTypePDF, _
Filename:="U:\Sample Excel File Saved As PDF", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
From:=1, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete 'delete the unwanted worksheet
Application.DisplayAlerts = True
End With
Application.ScreenUpdating = True
End Sub
Export Non-Contiguous Range to PDF
This solution uses the Application.Union method to create the range to be exported. The range is then copied using the Range.Copy method to a newly added worksheet and exported from there. Then the newly added worksheet is deleted.
Option Explicit
Sub CreatePDF_Selection1()
Const FilePath As String = "U:\Sample Excel File Saved As PDF"
Const SheetName As String = "Sheet1"
Dim wb As Workbook
Set wb = ThisWorkbook ' The workbook containing this code.
' Define Copy Range.
With wb.Worksheets(SheetName)
Dim rng As Range
Set rng = Union(.Range("A1:G9"), .Range("A13:G14"), .Range("A18:G37"))
End With
' Copy Copy Range to new worksheet, export to PDF and delete new worksheet.
With Worksheets.Add
' This will copy values and formats.
rng.Copy .Range("A1")
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=FilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=True
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End With
End Sub
The code that works on 2016 version selecting just the sheet name:
ActiveWorkbook.Worksheets("Summary").PivotTables("PivotTable8").PivotCache.Create(SourceType:=xlDatabase,
SourceData:= _
"Sheet1!R1C1:R29463CFI", Version:=xlPivotTableVersion15).CreatePivotTable TableDestination:="Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion:=6
In the below code I want the range for sourcedata to be fetched depending on the active cells of the sheet. In Excel 2016 the code works even if the entire sheet is selected but in Excel 2013, only if the range of active cells is provided does the code run.
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"Sheet1!R1C1:R29463C165", Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Sheet2!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion15
code would be like this. My version is 14.
Sub test()
Dim Ws As Worksheet, toWs As Worksheet
Dim Wb As Workbook
Dim pv As PivotTable, pvCache As PivotCache
Set Wb = ThisWorkbook
Set Ws = Sheets(1)
Set toWs = Sheets(2)
Set pvCache = Wb.PivotCaches.Create(xlDatabase, Ws.Range("a1").CurrentRegion, xlPivotTableVersion14)
Set pv = pvCache.CreatePivotTable(TableDestination:=toWs.Range("f1"))
End Sub
I recorded the pivot table macro and I'm trying to generalize source data instead of going off of sheet name "REPORTS"
It grabs all the data from active sheet despite what the name of the sheet.
This way I can use the macro to create a pivot table for any active sheet:-
Sheets("**REPORTS**").Select
Range("A1").Select
Sheets.Add.Name = "Pivot"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
Sheets("**REPORTS**").Range("A1").CurrentRegion, Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivot!R3C1", TableName:="PivotTable1", DefaultVersion _
:=xlPivotTableVersion15
Sheets("Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
Sub TT()
Dim shtSrc As Worksheet, shtDest As Worksheet
Dim pc As PivotCache
Set shtSrc = ActiveSheet
Set shtDest = shtSrc.Parent.Sheets.Add()
shtDest.Name = shtSrc.Name & "-Pivot"
Set pc = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=shtSrc.Range("A1").CurrentRegion)
pc.CreatePivotTable TableDestination:=shtDest.Range("A3"), _
TableName:="PivotTable1"
With shtDest.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
End Sub
This will not add any data to the pivot table but it will create it
Sub Example()
Dim PrevSheet As Worksheet
Set PrevSheet = ActiveSheet
Range("A1").Select
Sheets.Add.Name = "Pivot"
PrevSheet.Select
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, _
SourceData:=ActiveSheet.UsedRange, _
Version:=xlPivotTableVersion15).CreatePivotTable _
TableDestination:="Pivot!R3C1", _
TableName:="PivotTable1", _
DefaultVersion:=xlPivotTableVersion15
Sheets("Pivot").Select
Cells(3, 1).Select
With ActiveSheet.PivotTables("PivotTable1")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
End Sub