I need help with the below code and pivot table.
I run my script on a weekly basis and each time I need time select the last available item in the below pivot tables (PivotTable1, PivotTable2 and PivotTable3):
I tried the below code but it doesn't work:
Dim pi As PivotItem
Dim lLoop As Long
Dim pt As PivotTable
Dim lCount As Long
Dim lWeeks As Long
On Error Resume Next
lWeeks = 1
If lWeeks = 0 Then Exit Sub
Application.ScreenUpdating = False
Set pt = ActiveSheet.PivotTables("PivotTable1")
For Each pi In pt.PivotFields("Week").PivotItems
pi.Visible = False
Next pi
With pt.PivotFields("Week")
For lLoop = .PivotItems.Count To 1 Step -1
.PivotItems(lLoop).Visible = True
lCount = lCount + 1
If lCount = lWeeks Then Exit For
Next lLoop
End With
On Error GoTo 0
Application.ScreenUpdating = True
I also tried the below but it's still not working:
Sheets("Pivot").Select
ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate"). _
ClearAllFilters
ActiveSheet.PivotTables("PivotTable1").PivotFields("ExtractDate").CurrentPage _
= ThisWorkbook.Worksheets("Pivot").Range("B2").Value
In this case I'm having the Runtime Error 1004: Unable to get the PivotTables property of the Worksheet class.
Can you please advise how to modify the above codes to select the last available item in the 'Week' filter?
Also, how to modify this code to select the last value for these 3 pivot tables?
Thanks in advance.
You can set the current filter page with the name of the last (or first) PivotItem:
With ActiveSheet.PivotTables("PivotTable1").PageFields("Week")
.ClearManualFilter ' or ClearAllFilters
.AutoSort xlAscending, .SourceName
.CurrentPage = .Pivotitems(.Pivotitems.Count).Name
If .CurrentPage = "(blank)" And .Pivotitems.Count > 1 Then
.CurrentPage = .Pivotitems(.Pivotitems.Count - 1).Name
End If
End With
If the last entry is blank, it selects the previous one.
If you need the other end of your date range, just change xlAscending to xlDescending.
You can loop over all PivotTables in a worksheet and set each filter to the last page by this:
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
' Set pf = pt.PageFields("Week")
For Each pf In pt.PageFields
pf.ClearManualFilter ' or ClearAllFilters
pf.EnableMultiplePageItems = True
pf.AutoSort xlAscending, pf.SourceName
pf.CurrentPage = pf.Pivotitems(pf.Pivotitems.Count).Name
If pf.CurrentPage = "(blank)" And pf.Pivotitems.Count > 1 Then
pf.CurrentPage = pf.Pivotitems(pf.Pivotitems.Count - 1).Name
End If
Next pf
Next pt
At least 1 item has to remain visible, so you can't loop over all items and set them .Visible = False. A loop over all except the last PivotItem should work, but is too slow.
I added a .RefreshTable to refresh the data in your PivotTable. If there are still wrong informations, you can refresh the PivotCache of your workbook additionally:
Dim pc As PivotCache
For Each pc In ActiveWorkbook.PivotCaches
pc.MissingItemsLimit = xlMissingItemsNone
pc.Refresh
Next pc
Related
I have a macro that is building a bubble chart and for each row in the dynamic range it is creating a new series in the bubble chart. I tested the last row calculation was finding the actual last row both manually on the worksheet and with a quick macro to find the last row and display in a message box. So the macro for building the bubble chart is finding the last row correctly. The problem is that the macro is adding in blank series anyway beyond the last row. The macro is adding 10 generic series after the last row.
Macro below:
Sub bubble()
'
' bubble Macro for bubble chart
'
Dim Lastrow As Long, ws As Worksheet, wsRD As Worksheet, wsChart As Worksheet
Dim cht As ChartObject, currRow As Integer
Dim ch As Shape, SeriesNum As Integer
On Error GoTo ExitSub
For Each ws In ActiveWorkbook.Sheets
If Left(ws.Name, 12) = "Raw Data SEA" Then
Set wsRD = ws
End If
If Left(ws.Name, 10) = "SEA bubble" Then
Set wsChart = ws
End If
Next ws
Lastrow = wsRD.Cells(Rows.Count, 1).End(xlUp).Row
Set ch = wsChart.Shapes(1)
ch.Name = "SEACht"
SeriesNum = 1
For currRow = 2 To Lastrow
ch.Chart.SeriesCollection.NewSeries
ch.Chart.FullSeriesCollection(SeriesNum).Name = wsRD.Cells(currRow, 1)
ch.Chart.FullSeriesCollection(SeriesNum).XValues = wsRD.Cells(currRow, 2)
ch.Chart.FullSeriesCollection(SeriesNum).Values = wsRD.Cells(currRow, 4)
ch.Chart.FullSeriesCollection(SeriesNum).BubbleSizes = wsRD.Cells(currRow, 3)
SeriesNum = SeriesNum + 1
Next currRow
'Format Legend
ch.Chart.PlotArea.Select
ch.Chart.SetElement (msoElementLegendBottom)
ActiveWorkbook.Save
'Format X and Y axes
ch.Chart.Axes(xlCategory).Select
ch.Chart.Axes(xlCategory).MinimumScale = 0
ch.Chart.ChartArea.Select
ch.Chart.Axes(xlValue).Select
ch.Chart.Axes(xlValue).MinimumScale = 0
Application.CommandBars("Format Object").Visible = False
ActiveWorkbook.Save
' Format datalabels
ch.Chart.ApplyDataLabels
ch.Chart.FullSeriesCollection(1).DataLabels.Select
ch.Chart.FullSeriesCollection(1).HasLeaderLines = False
Application.CommandBars("Format Object").Visible = False
ActiveWorkbook.Save
' Add charttitle
'
ch.Chart.SetElement (msoElementChartTitleAboveChart)
ch.Chart.Paste
ch.Chart.ChartTitle.Text = _
"Properties operating exp - RSF and Building Age Factors"
ActiveWorkbook.Save
ExitSub:
End Sub
Thanks in advance for any help.
Checked that the last row calc was actually finding the last row to make sure that was not the issue. Tried recording the process again to see if I missed anything. I didn't see anything that was obvious to change.
Too long for a comment and maybe not the source of your problem, but NewSeries returns the added series, so you can do this and skip the SeriesNum counter:
Dim rw as Range
For currRow = 2 To Lastrow
Set rw = wsRD.Rows(currRow)
With ch.Chart.SeriesCollection.NewSeries
.Name = rw.Cells(1)
.XValues = rw.Cells(2)
.Values = rw.Cells(4)
.BubbleSizes = rw.Cells(3)
End With
Next currRow
After performing some operations this part of code goes to the sheet called "Overview", refreshes a huge pivot table - there is only one and it is called "PivotTable2" (actually, it doesn't refresh it and I don't know why). The part earlier that adds lines to the source works so after refreshing it manually everything works. Next, it chooses every cell with a value "Period" and what I need it to do is to clear filters in the selection "Period" and select two last values that pop up after the pivot table is refreshed.
ActiveWorkbook.Sheets("Overview").Activate
Dim pi As PivotItem
Dim pt As PivotTable
Dim pf As PivotField
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Set pf = pt.PageFields("PivotTable2").PivotFields("Period")
For Each pf In pt.PageFields
pf.ClearManualFilter
pf.ClearAllFilters
pf.EnableMultiplePageItems = True
pf.AutoSort xlAscending, pf.SourceName
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count).Name
If pf.CurrentPage = "(blank)" And pf.PivotItems.Count > 2 Then
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count - 2).Name
End If
If pf.CurrentPage = "(blank)" And pf.PivotItems.Count > 1 Then
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count - 1).Name
End If
Next pf
Next pt
End Sub
Run-time error '1004':
Unable to get the PageFields property of the PivotTable class
I would be happy if you point at a problem or suggest a solution. Thank you!
This code works, but instead of only working with the field "Period" as my code suggests it performs operations on all fields in a pivot table and chooses 2 last values in a filter.
Dim pi As PivotItem
Dim pt As PivotTable
Dim pf As PivotField
For Each pt In ActiveSheet.PivotTables
pt.RefreshTable
Set pf = ActiveSheet.PivotTables("PivotTable2").PivotFields("Period")
For Each pf In pt.PageFields
pf.ClearManualFilter
pf.ClearAllFilters
pf.EnableMultiplePageItems = True
pf.AutoSort xlAscending, pf.SourceName
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count).Name
If pf.CurrentPage = "(blank)" And pf.PivotItems.Count > 2 Then
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count - 2).Name
End If
If pf.CurrentPage = "(blank)" And pf.PivotItems.Count > 1 Then
pf.CurrentPage = pf.PivotItems(pf.PivotItems.Count - 1).Name
End If
Next pf
Next pt
The VBA below selects all and deselects 0 and blanks on a pivot table filter, essentially refreshing the pivot table after new data is entered. It works correctly on a single sheet but the issue I have is that PivotTable1 is copied across multiple sheets and I also want this to run this on them pivot tables.
I have tried to use an array to no avail and I'm too much of a rookie to figure out how to get this to continue the same VBA onto the next sheet/pivot table.
Option Explicit
Public Sub FilterOutZeroAndBlanks()
Dim pvt As PivotTable
Set pvt = ThisWorkbook.Worksheets("Cairns Table").PivotTables("PivotTable1")
Dim pvtField As PivotField
Set pvtField = pvt.PivotFields("Quantity")
Dim item As PivotItem
Dim counter As Long
Dim targetCounter As Long
With pvtField
For Each item In .PivotItems
If item.Visible Then counter = counter + 1
Next item
If .PivotItems("0").Visible And .PivotItems("(blank)").Visible Then
targetCounter = 2
ElseIf .PivotItems("0").Visible Or .PivotItems("(blank)").Visible Then
targetCounter = 1
End If
If Not targetCounter = counter Then
.PivotItems("0").Visible = False
.PivotItems("(blank)").Visible = False
End If
End With
End Sub
Make the pivottable a parameter - then you can more-easily re-use the method by calling it from another sub:
Sub Main()
With ThisWorkbook
FilterOutZeroAndBlanks .Worksheets("Cairns Table").PivotTables("PivotTable1")
FilterOutZeroAndBlanks .Worksheets("Other Table").PivotTables("PivotTable1")
End With
End Sub
Public Sub FilterOutZeroAndBlanks(pvt As PivotTable)
Dim pvtField As PivotField
Set pvtField = pvt.PivotFields("Quantity")
Dim item As PivotItem
Dim counter As Long
Dim targetCounter As Long
With pvtField
For Each item In .PivotItems
If item.Visible Then counter = counter + 1
Next item
If .PivotItems("0").Visible And .PivotItems("(blank)").Visible Then
targetCounter = 2
ElseIf .PivotItems("0").Visible Or .PivotItems("(blank)").Visible Then
targetCounter = 1
End If
If Not targetCounter = counter Then
.PivotItems("0").Visible = False
.PivotItems("(blank)").Visible = False
End If
End With
End Sub
I have a vba code which checks all the pivots in specified worksheets to add a range of pivotfield to the values/data section of the pivot because the pivot headers change every 4 weeks.
I have 6 pivots where this code works perfectly, but 2 pivots where I keep getting an error. I have tried to adjust the code but was not succesfull. I used this code to find the type for this pivot field as I thought it should be data, but it turns out to be 'hidden':
Set pvtTable = Worksheets("Sheet1").Range("A3").PivotTable
Set pvtField = pvtTable.PivotFields("ORDER_DATE")
Select Case pvtField.Orientation
Case xlHidden
MsgBox "Hidden field"
Case xlRowField
MsgBox "Row field"
Case xlColumnField
MsgBox "Column field"
Case xlPageField
MsgBox "Page field"
Case xlDataField
MsgBox "Data field"
End Select
I then checked this code on comparable fields in the pivots where it is working perfectly, expecting it would be data fields, but again it were hidden fields. I therefore do not understand what is different in these 2 pivots that makes my code not work compared to the pivots where the code works perfectly.
This is the code for the pivots where it is not working:
Sub AddAllFieldsValues_blad1()
Dim pt As PivotTable
Dim iCol As Long
Dim iColEnd As Long
Dim sheetnames As Variant
Dim I As Variant
With Sheets("blad1")
For Each pt In Sheets("blad1").PivotTables
With pt
.ManualUpdate = True
.DataPivotField.Orientation = xlHidden
iCol = 11
With .PivotFields(iCol)
If .Orientation = 0 Then
.Orientation = xlDataField
End If
End With
.ManualUpdate = False
pt.PivotCache.refresh
End With
Next pt
End With
End Sub
I only need the pivot to have 1 pivot field in the values section.
When I execute this code, I get this error:
error 1004:
propery orientation of class pivotfield cannot be set
And this line is marked when I click 'solve error' (or what it is called in english):
.DataPivotField.Orientation = xlHidden
I do not understand why because it works perfectly for the other pivots in the worksheet. The only thing that is different is that for those pivots, the code is slightly different:
Sub AddAllFieldsValues()
Dim pt As pivottable
Dim iCol As Long
Dim iColEnd As Long
Dim sheetnames As Variant
Dim I As Variant
sheetnames = Array("data pivots euros", "data pivots category - euros", "data pivots units", "data pivots category - units")
For I = LBound(sheetnames) To UBound(sheetnames)
With Sheets(sheetnames(I))
For Each pt In Sheets(sheetnames(I)).PivotTables
With pt
.ManualUpdate = True
.DataPivotField.Orientation = xlHidden
iCol = 12
iColEnd = .PivotFields.Count - 4
For iCol = 12 To iColEnd
With .PivotFields(iCol)
If .Orientation = 0 Then
.Orientation = xlDataField
End If
End With
Next iCol
.ManualUpdate = False
pt.PivotCache.refresh
End With
Next pt
End With
Next I
End Sub
The DataPivotField property is buggy, as it only works,
when your pivottable already has at least 2 datafields!
If you want to remove each datafield first, then replace the line
.DataPivotField.Orientation = xlHidden
by this:
Dim df as PivotField
For Each df In .DataFields
df.Orientation = xlHidden
Next df
Very late answer, but if anyone looks i believe this replicates what the question asks.
Dim xPivot As PivotTable
'setting exact pivot table also ensuring its targeting the correct sheet
Set xPivot = ThisWorkbook.Worksheets("Sheet1").PivotTables("Pivot_Table_Name")
'change "values" as required to view data fields/row fields etc
'change "Field Name" to match the value name
xPivot.PivotFields("Values").PivotItems("FieldName").Visible = False
Good mrng!
I am trying to create pivot table using vba and i am very new to pivot using vba and i tried to research in google as much as possible to get this corrected but didnt find much info which can help me to fix it, would be of great help if anyone can help me with this.
Range - always starts from A10, columns will be fixed until H but number of rows are not fixed hence i tried to define the range and use it in the code but its throwing me below error message, please check and correct me
Issues faced-Not able to define Rng as Range and not able to use this range in the pivot table.
Rng as Range
Run time error '91': Object variable or with black variance not set
Pivot cache
Run Time error '438': Object doesn't support this property or method
Data
ACT AN Currency CB LC Type CB FC Type SI
1001 c USD 2,031 Dr 2,031 Dr 0005
1002 a BHD 1,194 Dr 1,194 Dr 0105
1003 P EUR 326 Dr 326 Dr 0110
1004 AR GBP 60,467 Dr 60,467 Dr 0125
1005 AP DHS (73,080) Cr (73,080) Cr 0190
Sub Pivot()
Dim ws As Worksheet
Dim pc As PivotCache
Dim pt As PivotTable
'Dim Rng As Range
'Defining Range
Rng = Range("A10").Select
Rng = Range(Selection, Selection.End(xlToRight)).Select
Rng = Range(Selection, Selection.End(xlDown)).Select
'Adding new worksheet
Set ws = Worksheets.Add
'Creating Pivot cache
Set pc = ActiveWorkbook.PivotCaches.Create(xlDatabase, "Working!Rng").Select
'Creating Pivot table
Set pt = pc.CreatePivotTable(ws.Range("B3"))
'Setting Fields
With pt
'set row field
With .PivotFields("SI")
.Orientation = xlRowField
.Position = 1
End With
'set column field
With .PivotFields("Currency")
.Orientation = xlColumnField
.Position = 1
End With
End With
End Sub
Thanks for your help!
Regards
Suresh7860
Try and use the below code as a sample for what you need. If anything is unclear I will be happy to answer. But you won't learn if I write the code for you.
Sub BuildPT()
Dim pvtTbl As PivotTable
Dim pvtCha As PivotCache
Dim pvtDestWS As Worksheet
Dim pvtSrcWS As Worksheet
Dim pvtWB As Workbook
Dim pvtSrcRng As Range
Dim pvtStrt As Range
Dim keyRng As Range
Dim LastRow As Integer
Dim LastCol As Integer
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
pvtWB.Worksheets("Total").Delete 'Delete PT destination sheet
On Error GoTo 0
Set pvtSrcWS = pvtWB.Worksheets("Data") 'Set source sheet name
'Here I find the last row and column containing data
LastRow = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).row
LastCol = pvtSrcWS.Cells.Find(What:="*", After:=pvtSrcWS.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False, MatchByte:=False).Column
Set pvtSrcRng = Range(pvtSrcWS.Cells(1, 3), pvtSrcWS.Cells(LastRow, LastCol)) 'Set the range that contains the source data
Set pvtDestWS = pvtWB.Sheets.Add 'Add the destination sheet
pvtDestWS.Name = "Total" 'Rename destination sheet
Set pvtStrt = pvtDestWS.Cells(1, 1) 'Set the PT start location
'Here I create the pivot cache, the container that holds pivot table data
'Then I create the pivot table itself
Set pvtCha = pvtWB.PivotCaches.Create(xlDatabase, pvtSrcRng)
Set pvtTbl = pvtCha.CreatePivotTable(TableDestination:=pvtStrt, TableName:="Test PT")
'Now I add the fields I need
With pvtTbl
With .PivotFields("Amount")
.Orientation = xlDataField
.Function = xlSum
.NumberFormat = "#,##0"
End With
With .PivotFields("Account")
.Orientation = xlPageField
.CurrentPage = "513035"
End With
.PivotFields("Key").Orientation = xlRowField
.RepeatAllLabels xlRepeatLabels
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub