I have a pivot table set up(see image to get a better idea). I am trying to extract data from the pivot table based on the country. You can see that the row country gives access to the row region, and the row region gives access to row product. I want to copy the data under the constraint of: France to get both regions, all products, and the sum of price and move it to sheet2.
Here is my idea how I could go about it, but the select method is not supported in the current property/method. How might I go about selecting all of the data under france?
Sheets("MY Pivot").PivotTables("MY_Pivot").PivotFields("Country").PivotItems("France" _
).ShowDetail = True 'Show pivot item
Sheets("MY Pivot").PivotTables("MY_Pivot").PivotFields("Country").PivotItems("France" _
).Select 'Select pivot item to copy
Selection.Copy 'Copy the pivot items
Sheets("Sheet2").Range("A1").Select 'Select sheet cell for paste
Sheets("Sheet2").Paste 'Paste the selected France results
You can copy the .PivotItems("France").DataRange.EntireRow to "Sheet2", without the need to use Select.
Code
Option Explicit
Sub CopyPivotItemDataRange()
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
' set the Pivot Table object
Set PvtTbl = Sheets("MY Pivot").PivotTables("MY_Pivot")
' set the Pivot Field object
Set PvtFld = PvtTbl.PivotFields("Country")
With PvtFld
.PivotItems("France").ShowDetail = True 'Show pivot item
' copy >> paste the entire Range data under "France" to "Sheet2"
.PivotItems("France").DataRange.EntireRow.Copy Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub
Related
I have some VBA code which needs to select Prod. Code, Lims#, SampleID, Log Date, District Name, Region, Machine ID, Ash, cNDF, CP, Ca, Cl from a pivot table.
When I use Entire row, I can select all the data that I need to make a clean paste into column A. However, now I'd like to paste into column
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Select
I've attempted to do just data range, however it won't pull Prod.Code, Lims#, etc columns. It will only grab the analyte columns.
.PivotItems(PivotFieldName.Caption).DataRange.Select
I also tried to do a range off of the EntireRow, however then I can't figure out how to get last column or last row for that selected Prod. Code.
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Range("A1:BB1").Select
How can I got about getting all columns for a Prod. code selected like the Entire Row method excluding the extra rows?
The Prod.Code Columns & Rows can shift in size depending on the data so I need to make it capable of grabbing the right range.
Further code structure:
Dim PvtTbl As PivotTable
Dim PvtFld As PivotField
Set PvtTbl = Sheets("NEP Pivot").PivotTables("NEP_Pivot")
Set PvtFld = PvtTbl.PivotFields("Prod. Code")
For Each PivotFieldName In PvtFld.PivotItems
'PivotFieldName.Caption represents "EHB"
If IsError(Application.Match(PivotFieldName.Caption, rngList, 0)) Then
With PvtFld
On Error Resume Next
.PivotItems(PivotFieldName.Caption).ShowDetail = True 'Show pivot item
.PivotItems(PivotFieldName.Caption).DataRange.EntireRow.Copy
Destination:=Sheets(PivotFieldName.Caption).Range("A3")
...
..
.
Use the .DataBodyRange property instead to get all the data within the pivot
PivotTable.DataBodyRange Property (Excel)
Returns a Range object that represents the range of values in a
PivotTable. Read-only.
Syntax
expression . DataBodyRange
expression A variable that represents a PivotTable object.
As you also want the row element you can do the following you can resize the data body range according to the difference in column count between the larger TableRange2 property and that inside pivot area. Be aware that grand totals etc may affect this but this shows you how to start thinking about it. There is also a TableRange1 property available with pivots.
Example pivot:
Code:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim pvt As PivotTable
Dim columnsDifference As Long
Set ws = ActiveSheet
Set pvt = ws.PivotTables("PivotTable4")
columnsDifference = pvt.TableRange2.Columns.Count - pvt.DataBodyRange.Columns.Count
With pvt.DataBodyRange
Debug.Print .Offset(, -columnsDifference).Resize(.Rows.Count, .Columns.Count + columnsDifference).Address
End With
End Sub
I would recommend reading up on referencing pivottable ranges in VBA.
There are a variety of properties that you can use to determine ranges e.g. LabelRange and DataRange for fieldItems. You seems to have explored some of these. My experience has been that these are influenced by your pivottable layout and you will need to determine the current combination of methods to get your data.
For example, I used the following to get all the data for EHB with data laid out as follows:
Option Explicit
Sub test()
Dim ws As Worksheet
Dim pvt As PivotTable
Dim columnsDifference As Long
Dim wb As Workbook
Set wb = ThisWorkbook
Set ws = wb.Worksheets("mySheetName")
Set pvt = ws.PivotTables("NEP_Pivot")
columnsDifference = pvt.TableRange2.Columns.Count - pvt.DataBodyRange.Columns.Count
With pvt.DataBodyRange
Debug.Print pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Offset(-1, 0).Resize(pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Rows.Count, .Columns.Count + columnsDifference).Address
End With
End Sub
This produced the result
$C$11:$N$13
Notice how I have had to combine functions to get this result and if the pivottable layout gets changed this falls apart.
I was also able to write using:
With pvt.TableRange1
Debug.Print pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Resize(pvt.PivotFields("Prod. Code").PivotItems("EHB").LabelRange.Rows.Count, .Columns.Count).Offset(-1, 0).Address
End With
Got another Excel VBA Macro button issue.
I am trying to make a button to refresh all pivots on a worksheet (there are four). I have been to StackOverflow before and received a solution that worked well. I took the code I was provided before and updated it for the new workbook but it fails below with the function .ChangePivotCache PvtCache:
Sub Button1_Click()
Dim PvtTbl As PivotTable
Dim PvtCache As PivotCache
Dim PvtDataRng As Range
Set PvtDataRng = Worksheets("OTR_Promo_List_ADV_2017").Range("B2:AU500")
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, PvtDataRng)
Set PvtTbl = Worksheets("Desired_Distribution").PivotTables("PivotTable1")
For Each PvtTbl In Worksheets("Desired_Distribution").PivotTables
Set PvtCache = ActiveWorkbook.PivotCaches.Add(xlDatabase, PvtDataRng)
With PvtTbl
.ChangePivotCache PvtCache
.RefreshTable
End With
Set PvtCache = Nothing
Next PvtTbl
End Sub
The only differences are that the workbook changed and now I want to refresh 4 pivots instead of 2 - could that be the issue?
Below a screenshot so you can see the worksheets. "OTR_Promo_List_ADV-2017" is the database. The Pivot tables have the default naming, I did not change the names (i.e. PivotTable1, PivotTable2...)
Thanks!
The code you use to refresh all pivot tables on the one sheet seems overly complex. I don't quite understand why you would want to use .ChangePivotCache at all. It changes the data source of the specified pivot table. If you just want to refresh a pivot table, that is completely unwarranted.
You can use Excel Table objects as the data source for your pivot tables, then a simple refresh will suffice. Or, if you don't want to use Tables (though you may really want to look into that, for obvious reasons), you can use dynamic range names to define the pivot source. With both techniques, you only need to refresh the pivot table and don't have to manipulate the pivot cache with VBA.
With Tables or dynamic range names as the source of pivot tables, you can refresh all pivot tables on a sheet by cycling through them and refresh them with codes along these lines:
Sub RefreshPivotsOnSheet()
Dim ws As Worksheet
Dim pt As PivotTable
Set ws = Worksheets("MySheet")
For Each pt In ws.PivotTables
pt.RefreshTable
Next pt
End Sub
Edit: How to set Excel Tables as the data source for a pivot: Turn the source data into a table with Ctrl + T or Insert > Table. Then edit the Pivot Table data source and point it to the Excel table you just created.
I was able to close this topic. I found somewhere else a simple macro that says only:
Sub REFRESH()
'
' REFRESH Macro
'
'
ActiveWorkbook.RefreshAll
End Sub
seemed to do the trick.
Thank you for all your inputs!
I have been racking my brain over this code. I am trying to copy a set of data from table "CST" to the end of a currently populated table titled "HT_Table" and input the type of test that was run for the entries I am pasting. The historical data table should have a running list of entries.
Each time I run the macro I want to copy "[[Social Security Number]:[Rehire Date]]" into the bottom of a different table that has a running list of selections and add "Loan" to the right of it under the "Test" column.
Sub Copy_Data
'Copy critical data
Dim tbl As ListObject
Set tbl = CST.ListObjects(1)
Range(tbl & "[[Social Security Number]:[Rehire Date]]").Copy
Windows("Historical Testing.xlsx").Activate
'I named the column in the table I am pasting to "SSN"
Range("SSN").End(xlDown).Select
ActiveCell.Offset(1, 0).PasteSpecial
Dim PY As Worksheet
Set PY = ActiveSheet
With PY.ListObjects("HT_Table")
.ListColumns("Test").Range.Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)) = "Loan"
End With
End Sub
I run into problems with the Selection.End(x1Down)) if there is only one row pasted to the bottom of the table. The above code selects the one row and then highlights all the way to the end of the worksheet.
Each week I pull data for a series of items and generate a pivot table. Some weeks, no data exists for one or more of these items. When this is the case, that item won't appear on the report.
To avoid manually checking that no items have been accidentally excluded from the pivot table, I want to manually add "dummy" items to the data used in the pivot table.
I am pretty confident I can identify which dummy items to add by using COUNTIF between the master item sheet and the raw data. My challenge is that the number of rows in the pivot table varies week to week, so I need to 1) identify the last row of the raw data report, and 2) insert dummy rows below the last line.
Can anyone suggest a strategy using the example below?
Items in Data
AAA
BBB
DDD
FFF
Items Not in Data to Manually Insert
CCC
EEE
I am not getting any errors, but this isn't working.
Sub DUMMY_ITEMS()
'
' DUMMY_ITEMS Macro
Sheets("Operations").Select
Range("H2:V73").Select
Selection.Copy
Sheets("Raw Data").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Thanks for your code in the comment here is the fixed version:
Sub DUMMY_ITEMS()
Dim operationsSheet As Worksheet
Dim rawDataSheet As Worksheet
Dim copyRange As Range
Dim LastRow As Long
Set operationsSheet = Sheets("Operations")
Set rawDataSheet = Sheets("Raw Data")
operationsSheet.Range("H2:V73").Copy
With rawDataSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
rawDataSheet.Cells(LastRow, 1).PasteSpecial xlPasteValues
End Sub
I would however highly recommend you look into the Offset solution below to have a dynamic pivot data source.
On top of all that there is a neat trick to always keep your pivot table up to speed:
Create a named range of a name rData
=OFFSET($A$1;;;COUNTA(A:A);COUNTA(1:1))
Where A1 is the begging of your PivotTable, COUNTA(A:A) counts the amount of rows it needs to extend the range to (pick any column that is filled in for all records), and COUNTA(1:1) counts the amount of headers.
Put rData as pivot source. rData will extend any time you add a row or column. No macros needed.
I usually assign the full table to a data range
Set currentData = ActiveWorksheet.Range("A1").CurrentRegion
Where Range("A1") is the beggining of the dataset
with currentData
lastRow = .rows(.rows.count).row
end with
May not be the most optimal way to do it but works for me
Then you can thing underneath using
ActiveWorksheet.Cells(lastRow+1,1).Value = "CCC"
ActiveWorksheet.Cells(lastRow+2,1).Value = "EEE"
Or you can use offset
Set rangeToFill = ActiveWorksheet.Cells(lastRow,1)
rangeToFill.offset(1,0).value ="CCC"
rangeToFill.offset(2,0).value ="EEE"
Hope this is of some help.
I have data of this form:
Category Source Amount
Dues FTW $100
Donations ODP $20
Donations IOI $33
Dues MMK $124
There is no sort order. The categories are unknown at compile time. I want a VBA macro to cycle through the range, output a list of distinct values, with the subtotals for each. For the above data, it would look like this:
Category Total Amount
Dues $224
Donations $55
How can I do this? Also, is there a way to make the macro run every time the table above is updated, or is it necessary for the user to click a button?
You may want to use a built in Excel feature to do this. Looping can take a long time and be problematic if you have a lot of values to loop through.
Something like the following might get you started on creating a pivot table (from http://www.ozgrid.com/News/pivot-tables.htm)
Sub MakeTable()
Dim Pt As PivotTable
Dim strField As String
'Pass heading to a String variable
strField = Selection.Cells(1, 1).Text
'Name the list range
Range(Selection, Selection.End(xlDown)).Name = "Items"
'Create the Pivot Table based off our named list range.
'TableDestination:="" will force it onto a new sheet
ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
SourceData:="=Items").CreatePivotTable TableDestination:="", _
TableName:="ItemList"
'Set a Pivot Table variable to our new Pivot Table
Set Pt = ActiveSheet.PivotTables("ItemList")
'Place the Pivot Table to Start from A3 on the new sheet
ActiveSheet.PivotTableWizard TableDestination:=Cells(3, 1)
'Move the list heading to the Row Field
Pt.AddFields RowFields:=strField
'Move the list heading to the Data Field
Pt.PivotFields(strField).Orientation = xlDataField
End Sub
This is for subtotals (though I much prefer pivot tables)
http://msdn.microsoft.com/en-us/library/aa213577(office.11).aspx
EDIT:
I reread and have the following thoughts. Set up the pivot table on a separate sheet (without using any code) then put the following code on the sheet that has the pivot table so that the table will update everytime the sheet is selected.
Private Sub Worksheet_Activate()
Dim pt As PivotTable
'change "MiPivot" to the name of your pivot table
Set pt = ActiveSheet.PivotTables("MyPivot")
pt.RefreshTable
End Sub
Edit #2
Refresh all pivot tables on sheet
http://www.ozgrid.com/VBA/pivot-table-refresh.htm
Private Sub Worksheet_Activate()
Dim pt As PivotTable
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Next pt
End Sub
The link has multiple options on how to refresh pivot tables in the sheet/workbook.