How do I dynamically select the range of the sheet - excel

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

Related

Sorting data by multiple columns with zeros and blanks

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

VBA Filter Unique Values and copy those to a new sheet

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

VBA Copy Pivot Table to New Sheet

I am trying to copy a pivot table to an existing sheet.
I have successfully copied a previous pivot table to this sheet, which is causing me issues when copying a second one.
Current error message is:
Run-time error '1004': Application-defined or object-defined error.
I want to paste the pivot table in cell D64, as the cells below and to the right of this cell are all clear. My existing pivot table is in cell A64:B36.
Can anyone help figure out what I am doing wrong?
Sub ObsoPivotCopy
Dim PSheet As Worksheet
Dim DSheet As Worksheet
Dim PCache As PivotCache
Dim PTable As PivotTable
Dim Prange As Range
Dim lastRow As Long
Dim lastCol As Long
Set PSheet = Worksheets("1188 MJ Summary")
Set DSheet = Worksheets("ObsoCopy")
'Define Data Range
lastRow = DSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = DSheet.Cells(1, Columns.Count).End(xlToLeft).Column
Set Prange = DSheet.Cells(1, 1).Resize(lastRow, lastCol)
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create _
(SourceType:=xlDatabase, SourceData:=Prange). _
CreatePivotTable(TableDestination:=PSheet.Cells(200, 200), _
TableName:="ObsoPivot")
'Insert Blank Pivot Table
Set PTable = PCache.CreatePivotTable _
(TableDestination:=PSheet.Cells(200, 200), TableName:="ObsoPivot")
'Insert Data Fields
ActiveSheet.PivotTables("ObsoPivot").AddDataField ActiveSheet.PivotTables( _
"ObsoPivot").PivotFields("MARGIN €"), "Sum of MARGIN €", xlSum
ActiveWindow.SmallScroll Down:=21
ActiveSheet.PivotTables("ObsoPivot").PivotFields("Sum of MARGIN €"). _
Orientation = xlHidden
ActiveSheet.PivotTables("ObsoPivot").AddDataField ActiveSheet.PivotTables( _
"ObsoPivot").PivotFields("NET MARGIN €"), "Sum of NET MARGIN €", xlSum
End Sub
'Define Pivot Cache
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Prange). _
CreatePivotTable(TableDestination:=PSheet.Cells(200, 200), TableName:="ObsoPivot")
you're creating a pivotcache and then directly calling CreatePivotTable on that cache: that will return a PivotTable, not a PivotCache...
So you only need the first part:
Set PCache = ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=Prange)

Run time error 1004 for pivot table creation

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

Excel VBA - Generalize Pivot Source Data / Range

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

Resources