I'm working with a pivot table, and am using the following code:
Sub SortCTRDescending()
ActiveSheet.PivotTables("PivotTable6").PivotFields("Industry").AutoSort _
xlDescending, "Total CTR", ActiveSheet.PivotTables("PivotTable6"). _
PivotColumnAxis.PivotLines(6), 1
End Sub
Is there a way to pass the Pivot Field "Industry" as a variable depending on what is selected in the pivot table rows? i.e. if Industry changes to "List Name", have the variable set to whatever row label selected (assumes only 1 row label)? These then get passed to a button, which would "sort by CTR" or "sort by Open Rate" where column numbers stay the same.
Edit: Added a screenshot of the data. The Row Label is Industry, but this can change to any of the other fields, how can I make the first row label the primary sorting variable.
You can loop through the RowFields of the PivotTable to find the name of the current field. The code checks to ensure that the table currently has only 1 RowField. Make adjustments for your specific object names.
Sub SortCTRDescending()
Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField, pField As PivotField
Dim sField As String
Set ws = Worksheets("Sheet1") 'change as needed
Set pt = ws.PivotTables("PivotTable6")
If pt.RowFields.Count = 1 Then
'note that even though there is only one field, the loop is needed to get the name
For Each pField In pt.RowFields
sField = pField.Name
Next
Else
MsgBox "Whoa! More Than 1 Row Field!"
Exit Sub
End If
Set pf = pt.PivotFields(sField)
pf.AutoSort xlDescending, "Total CTR", pt.PivotColumnAxis.PivotLines(6), 1
End Sub
Related
I'm using a filter on a sheet in Excel. All I want to do is uncheck "empty cells" in field 1 of my filterrange. I know how to uncheck the "empty cells" but the existing filter (made by user) must stay active.
Code I'm using to get the name of the filterrange:
Dim obj As ListObject
Dim Tabel As String
Dim filter As Boolean
filter = False
For Each obj In ActiveSheet.ListObjects
Tabel = obj.Name
Exit For
Next
Code that I use to uncheck "empty cells" when no filter is applied:
ActiveSheet.ListObjects(Tabel).Range.AutoFilter field:=1, Criteria1:="<>"
What I prefer to get is the actual filter used in field 1, add the criteria:="<>" do my thing en reapply the filter applied by the user.
Thing I was trying:
Dim ActieveFilters As String
Dim FilterArray()
Dim LaatsteFilter As Long
Dim i As Long
With ActiveSheet.ListObjects(Tabel).AutoFilter.Filters(1)
ReDim FilterArray(1 To .Count)
For f = 1 To .Count
With .Item(f)
If .On Then
FilterArray(f) = Criteria1
End If
End With
Next f
End With
Active filters
VBA
Excel 2016
I'm trying to dynamically resize a range if the number of columns is less for that range after some code is executed. Referenced the MS files and various online examples with no luck. https://msdn.microsoft.com/en-us/library/office/ff193274.aspx
I can achieve the correct resize only if I do something like "testRange.Resize Range("A1:G1"). However I am looking for something along the lines of:
Sub Test_Range()
Dim Test As Worksheet
Set Test = Worksheets("test")
Dim testTable As Range
Set testTable = Test.Range("testTable[]")
Dim testTableWidth, testNumbersWidth As Integer
Set testTableWidth = testTable.Columns.Count
'Some code
'testNumbersWith is defined here
If testNumbersWidth < testTableWidth Then
testTable.Resize(, testNumbersWidth)
End If
End Sub
The method to resize a "Named Range" is different if it is a "normal" named range or a "Table" (ListObject) range. Your title refers to the first case but from your code it seems you are working with a table.
For the case of a named range, you change the scope like this (i.e. to change the number of columns):
With ThisWorkbook.Names.Item("testTable")
.RefersTo = .RefersToRange.Resize(, newColumnsCount)
End With
For the case of a Table (ListObject), which seems to be your case, you can change the number of columns like this:
Dim testTable As ListObject ' <-- Declare as ListObject
Set testTable = Test.ListObjects("testTable")
' Or Set testTable = Test.Range("testTable")
'Some code
' ....
testTable.Resize testTable.Range.Resize(, newColumnsCount) ' <-- resize number of cols
Assuming your other code .ClearContents on some columns in the Table (ListObject), say originally you have this:
Then lets say some code clears the content of columns D and I (headers C and H):
Running the code below will remove those columns from Table (by deleting the entire column). You can then use the list table's .DataBodyRange to access the table data only.
Option Explicit
Sub TableResize()
Dim oTable As ListObject, oRng As Range, sColsToDelete As String
Set oTable = ActiveSheet.ListObjects("Table1")
For Each oRng In oTable.HeaderRowRange
Debug.Print oRng.Address(0, 0), oRng.Value
If oRng.Value Like "Column*" Then
Debug.Print "Column " & oRng.Column & " to be deleted"
' Note order to delete is reversed!
If Len(sColsToDelete) > 0 Then sColsToDelete = "," & sColsToDelete
sColsToDelete = oRng.Column & sColsToDelete
End If
Next
If Len(sColsToDelete) > 0 Then DeleteCol sColsToDelete
' Example to access the data ranges
For Each oRng In oTable.DataBodyRange
Debug.Print oRng.Address(0, 0), oRng.Value
Next
Set oTable = Nothing
End Sub
Private Sub DeleteCol(sList As String)
Dim oItem As Variant
For Each oItem In Split(sList, ",")
ActiveSheet.Columns(CLng(oItem)).Delete
Next
End Sub
The result of the TableResize execution:
I have a pivot table, and I am trying to select certain pivot items based on values in an array. I need this process to go faster, so I have tried using Application.Calculation = xlCalculationManual and PivotTables.ManualUpdate = True, but neither seem to be working; the pivot table still recalculates each time I change a pivot item.
Is there something I can do differently to prevent Excel from recalculating each time?
Or is there a way to deselect all items at once (not individually) to make the process go quicker?
Here is my code:
Application.Calculation = xlCalculationManual
'code to fill array with list of companies goes here
Dim PT As Excel.PivotTable
Set PT = Sheets("LE Pivot Table").PivotTables("PivotTable1")
Sheets("LE Pivot Table").PivotTables("PivotTable1").ManualUpdate = True
Dim pivItem As PivotItem
'compare pivot items to array.
'If pivot item matches an element of the array, make it visible=true,
'otherwise, make it visible=false
For Each pivItem In PT.PivotFields("company").PivotItems
pivItem.Visible = False 'initially make item unchecked
For Each company In ArrayOfCompanies()
If pivItem.Value = company Then
pivItem.Visible = True
End If
Next company
Next pivItem
It seems that you really want to try something different to significantly reduce the time it takes to select the required items in pivotttable.
I propose to use a “MirrorField”, i.e. a copy of the “Company” to be used to set in the sourcedata of the pivottable the items you need to hide\show.
First you need to add manually (or programmatically) the “MirrorField” and named same as the source field with a special character at the beginning like “!Company” the item must be part of the sourcedata and it can be placed in any column of it (as this will a “programmer” field I would place it in the last column and probably hidden as to not creating any issues for\with the users)
Please find below the code to update the pivottable datasource and to refresh the pivottable
I’m also requesting the PivotField to be updated just make it flexible as it then can be used for any field (provided that the “FieldMirror” is already created)
Last: In case you are running any events in the pivottable worksheet they should be disable and enable only to run with the last pivottable update
Hope this is what you are looking for.
Sub Ptb_ShowPivotItems_MirrorField(vPtbFld As Variant, aPtbItmSelection As Variant)
Dim oPtb As PivotTable
Dim rPtbSrc As Range
Dim iCol(2) As Integer
Dim sRC(2) As String
Dim sFmlR1C1 As String
Dim sPtbSrcDta As String
Rem Set PivotTable & SourceData
Set oPtb = ActiveSheet.PivotTables(1)
sPtbSrcDta = Chr(34) & oPtb.SourceData & Chr(34)
Set rPtbSrc = Evaluate("=INDIRECT(" & sPtbSrcDta & ",0)")
Rem Get FieldMirrow Position in Pivottable SourceData (FieldMirrow Already present SourceData)
With rPtbSrc
iCol(1) = -1 + .Column + Application.Match(vPtbFld, .Rows(1), 0)
iCol(2) = Application.Match("!" & vPtbFld, .Rows(1), 0)
End With
Rem Set FieldMirror Items PivotTable SourceData as per User Selection
sRC(1) = """|""&RC" & iCol(1) & "&""|"""
sRC(2) = """|" & Join(aPtbItmSelection, "|") & "|"""
sFmlR1C1 = "=IF(ISERROR(SEARCH(" & sRC(1) & "," & sRC(2) & ")),""N/A"",""Show"")"
With rPtbSrc.Offset(1).Resize(-1 + rPtbSrc.Rows.Count).Columns(iCol(2))
.Value = "N/A"
.FormulaR1C1 = sFmlR1C1
.Value = .Value2
End With
Rem Refresh PivotTable & Select FieldMirror Items
With oPtb
Rem Optional: Disable Events - In case you are running any events in the pivottable worksheet
Application.EnableEvents = False
.ClearAllFilters
.PivotCache.Refresh
With .PivotFields("!" & vPtbFld)
.Orientation = xlPageField
.EnableMultiplePageItems = False
Rem Optional: Enable Events - To triggrer the pivottable worksheet events only with last update
Application.EnableEvents = True
.CurrentPage = "Show"
End With: End With
End Sub
It seems unavoidable to have the pivotable refreshed every time a pivotitem is updated.
However I tried approaching the problem from the opposite angle. i.e.:
1.Validating the “PivotItems to be hidden” before updating the pivottable.
2.Also making make all items visible at once instead of “initially make item unchecked” one by one.
3.Then hiding all the items not selected by the user (PivotItems to be hidden)
I ran a test with 6 companies selected out of a total of 11 and the pivottable was updated 7 times
Ran also your original code with the same situation and the pivottable was updated 16 times
Find below the code
Sub Ptb_ShowPivotItems(aPtbItmSelection As Variant)
Dim oPtb As PivotTable
Dim oPtbItm As PivotItem
Dim aPtbItms() As PivotItem
Dim vPtbItm As Variant
Dim bPtbItm As Boolean
Dim bCnt As Byte
Set oPtb = ActiveSheet.PivotTables(1)
bCnt = 0
With oPtb.PivotFields("Company")
ReDim Preserve aPtbItms(.PivotItems.Count)
For Each oPtbItm In .PivotItems
bPtbItm = False
For Each vPtbItm In aPtbItmSelection
If oPtbItm.Name = vPtbItm Then
bPtbItm = True
Exit For
End If: Next
If Not (bPtbItm) Then
bCnt = 1 + bCnt
Set aPtbItms(bCnt) = oPtbItm
End If
Next
ReDim Preserve aPtbItms(bCnt)
.ClearAllFilters
For Each vPtbItm In aPtbItms
vPtbItm.Visible = False
Next
End With
End Sub
I currently want to store a bunch of graphs/chart objects to an array in VBA so I can either print them all out later or export them to a PDF. What is the best way to go about this? Do I have to use the shapes object or can I just do it with charts?
Sub onButtonClick()
Dim source As Worksheet, target As Worksheet
Set source = Workbooks("End Market Monitor.xlsm").Worksheets("Aero Graphs")
Set target = Sheet1
Dim ws As Worksheet
Dim title_name As String, search As String
search = ActiveCell.Offset(0, -5).Value
ReDim chartArray(1 To source.ChartObjects.Count) As Chart
For i = 1 To source.ChartObjects.Count
title_name = source.ChartObjects(i).Chart.ChartTitle.Text
counter = 1
If InStr(title_name, search) > 0 Then
Set chartArray(counter) = source.ChartObjects(i).Chart
counter = counter + 1
End If
Next
Set wsTemp = Sheets.Add
tp = 10
With wsTemp
For n = 1 To UBound(chartArray)
chartArray(n).CopyPicture
wsTemp.Range("A1").PasteSpecial
Selection.Top = tp
Selection.Left = 5
tp = tp + Selection.Height + 50
Next
End With
wsTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=NewFileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
You can get rid of ActiveCell.Select. The active cell is already selected. It's redundant/unnecessary. Won't cause any errors, but it doesn't need to be there.
There is an error with this line:
chartArray(i) = source.ChartObjects(i).Chart
You need to use the Set keyword when assigning to objects, and your chartArray() is an array of Objects.
Set chartArray(i) = source.ChartObjects(i).Chart
You should Dim all variables on their own line, or explicitly type them. This is wrong:
Dim source, target As Worksheet
Because VBA doesn't support implicit/in-line declarations. What you've really done is:
Dim source as Variant, target as Worksheet
Change to:
Dim source as Worksheet, target as Worksheet
Do the same with title_name and search.
The variable name is undeclared and unassigned. The variable i is undeclared. Not an error, but it's a bad habit to get in to. You can avoid this by using Option Explicit at the top of each module. You will need to assign name some value otherwise the Instr test will always be false, and no charts will be assigned to the array.
Your ReDim statement is wrong because you're re-dimensioning it within the loop, effectively erasing it every iteration. Put this outside of the for/next loop.
ReDim chartArray(1 to source.ChartObjects.Count)
Putting it all together, your code should be like:
Option Explicit
Sub onButtonClick()
Dim source as Worksheet, target As Worksheet
Set source = Workbooks("End Market Monitor.xlsm").Worksheets("Aero Graphs")
Set target = Sheet1
Dim title_name As String, search As String
Dim name as String
name = "???" '## YOU NEED TO UPDATE THIS SOMEHOW
search = Range("J3").Offset(0, -5).Value
ReDim chartArray(1 To source.ChartObjects.Count) As Chart
For i = 1 To source.ChartObjects.Count
title_name = source.ChartObjects(i).Chart.ChartTitle.Text
If InStr(title_name, name) > 0 Then
Set chartArray(i) = source.ChartObjects(i).Chart
End If
Next
End Sub
UPDATE
You can use this procedure for multiple buttons. Currently you had hard-coded Range("J3") representing the cell location of the one command button. You can modify it like this and then assign the same macro to all of the buttons:
search = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(0, -5).Value
Make sure that the button's TopLeftCell is in Column F or higher. If this is in column A, B, C, D or E it will fail.
I have a dataset in a worksheet that can be different every time. I am creating a pivottable from that data, but it is possible that one of the PivotItems is not there. For example:
.PivotItems("Administratie").Visible = False
If that specific value is not in my dataset, the VBA script fails, saying that it can't define the item in the specified Field. (error 1004)
So I thought a loop might work.
I have the following:
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim pvtItems As PivotItems
For Each pvtItem In pvtField.pvtItems
pvtItem.Visible = False
Next
But that gives me an 91 error at the For Each pvtItem line:
Object variable or With block variable not set
I thought I declared the variables well enough, but I am most likely missing something obvious...
I've got it! :D
Dim Table As PivotTable
Dim FoundCell As Object
Dim All As Range
Dim PvI As PivotItem
Set All = Worksheets("Analyse").Range("A7:AZ10000")
Set Table = Worksheets("Analyse").PivotTables("tablename")
For Each PvI In Table.PivotFields("fieldname").PivotItems
Set FoundCell = All.Find(PvI.Name)
If FoundCell <> "itemname" Then
PvI.Visible = False
End If
Next
woohoo
Thanks to MrExcel, the answer was there after all, though deeply buried.
For Each pvtField In Worksheets("my_sheet").PivotTables("my_table").PivotFields
For Each pvtItem In pvtField.PivotItems
Debug.Print vbTab & pvtItem.Name & ".Visible = " & pvtItem.Visible
/*.PivotItems(pvtItem).Visible = False*/
Next
Next
.PivotItems("certain_Item").Visible = True
That doesn't work still... all the variables are still visible. No error is shown, it compiles yet the values are still there.
The commented line I added there was my own "invention" but it's is not valid.
Edit: Quicky question: Can I use an IF statement to check if a certain PivotItem is actually in the PivotTable Data? Something like
If PivotItem("name_of_the_thing") = present Then {
do_something()
}
When I implement the code posted by Patrick, an -
Unable to set the visible property of the PivotItem class
- error is thrown.
Microsoft admits there's a bug: M$ help
But just hiding the line... is not an option ofcourse.
Try something like this:
Public Function Test()
On Error GoTo Test_EH
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim pvtItems As PivotItems
' Change "Pivot" to the name of the worksheet that has the pivot table.
' Change "PivotTable1" to the name of the pivot table; right-click on the
' pivot table, and select Table Options... from the context menu to get the name.
For Each pvtField In Worksheets("Pivot").PivotTables("PivotTable1").PivotFields
Debug.Print "Pivot Field: " & pvtField.Name
For Each pvtItem In pvtField.VisibleItems
pvtItem.Visible = False
Next
Next
Exit Function
Test_EH:
Debug.Print pvtItem.Name & " error(" & Err.Number & "): " & Err.Description
Resume Next
End Function
If you want a function to just test for the existence of a pivot item, you can use something like this:
Public Function PivotItemPresent(sName As String) As Boolean
On Error GoTo PivotItemPresent_EH
PivotItemPresent = False
For Each pvtField In Worksheets("Pivot").PivotTables("PivotTable1").PivotFields
For Each pvtItem In pvtField.VisibleItems
If pvtItem.Name = sName Then
PivotItemPresent = True
Exit Function
End If
Next
Next
Exit Function
PivotItemPresent_EH:
Debug.Print "Error(" & Err.Number & "): " & Err.Description
Exit Function
End Function
You can call this from your code like this:
If PivotItemPresent("name_of_the_thing") Then
' Do something
End If
The error is thrown at the end of the loop.
I combined both answers from Patrick into the following:
With ActiveSheet.PivotTables("Table").PivotFields("Field")
Dim pvtField As Excel.PivotField
Dim pvtItem As Excel.PivotItem
Dim pvtItems As Excel.PivotItems
For Each pvtField In Worksheets("Sheet").PivotTables("Table").PivotFields
For Each pvtItem In pvtField.PivotItems
If pvtItem.Name = "ItemTitle" Then
pvtField.PivotItems("ItemTitle").Visible = True
Else
pvtField.PivotItems(pvtItem.Name).Visible = False
End If
Next
Next
End With
If the Item matches a particular string, that Item is set True. Else; Item set False. At the False condition the error is thrown.
I know there is exactly one match for the True condition. Though when I 'F8' my way through the macro, the True condition is never entered...
And that explains the error, everything is set False. (thanks Patrick!)
Leads me to the question... what exactly IS a PivotItem?
Idea of the thing:
It solves (or should solve) the following: a set of Data with a variable size where, for this specific table, one column is of interest. From that column I need the count of a value and have that put in a table. There are some conditions to the table, and a combination with another column is needed as well, so PivotTable is the best solution.
The problem is: in some datasets that one specific value does not appear. The values that DO appear are different every time.
The PivotItems are the individual values in a field (column, row, data). I think of them as the "buckets" that hold all the individual data items you want to aggregate.
Rather than go through all the pivot table fields (column, row, and data), you can just go through the fields you're interested in. For example, this code will show only the specified pivot items for the specified field:
Public Sub ShowInPivot(Field As String, Item As String)
On Error GoTo ShowInPivot_EH
Dim pvtField As PivotField
Dim pvtItem As PivotItem
Dim pvtItems As PivotItems
For Each pvtItem In Worksheets("Pivot").PivotTables("PivotTable1").PivotFields(Field).PivotItems
If pvtItem.Name = Item Then
pvtItem.Visible = True
Else
pvtItem.Visible = False
End If
Next
Exit Sub
ShowInPivot_EH:
Debug.Print "Error(" & Err.Number & "): " & Err.Description
Exit Sub
End Sub
Suppose I have a pivot table showing the count of issues per customer release and where they were detected in our SDLC. "Customer" and "Release" are column fields and "Phase" is a row field. If I wanted to limit the pivot table to counting issues for CustomerA, Release 1.2 during QA I could use the sub above like this:
ShowInPivot "Customer", "CustomerA"
ShowInPivot "Release", "1.2"
ShowInPivot "Phase", "QA"
You can't say ".PivotItems(pvtItem).Visible" outside a "With" block. Say "pvtField.PivotItems(pvtItem.Name).Visible = False" instead.
I also edited my original answer to include error handling for when Excel can't set the Visible property. This happens because the Pivot table needs at least one row field, one column field and one data item, so the last of each of these can't be made invisible.
You 'll also get the 1004 errror when trying to access a pivot item that is already invisible; I think you can ignore those.
I had same error message too when trying to set pivotitem visible true and false .. this had worked previously, but wasn't working any more ... i was comparing two values, and had not explicitly changed string to integer for comparison .. doing this made error disappear..
.. so if you get this message, check if any values being compared to make the item visible or not are being compared properly .. otherwise pivotitem is null and it can't make that visible or not.
I had an error that said "unable to set the visible property of the pivot item class"
at this line:
For Each pi In pt.PivotFields("Fecha").PivotItems
If pi.Name = ffan Then
pi.Visible = True
Else
pi.Visible = False '<------------------------
End If
Next pi
Then i read on internet that I had to sort manual and then clear the cache. i did that but the error still appeared..... then i read that it was because i had date on that pivot field so i change it firs my colum to general number then the date i wanted to set visible i change it to general number too. then no problem!!!!!!!!!!!!!!.... here it is.... i hope this can be helpfull because i was desperate!!!
Dim an As Variant
an = UserForm8.Label1.Caption 'this label contains the date i want to see its the pivot item i want to see of my pivot fiel that is "Date"
Dim fan
fan = Format(an, "d m yyyy")
Dim ffan
ffan = Format(fan, "general number")
Sheets("Datos refrigerante").Activate 'this is the sheet that has the data of the pivottable
Dim rango1 As Range
Range("B1").Select
Range(Selection, Selection.End(xlDown)).Select
Set rango1 = Selection
ActiveSheet.Cells(1, 1).Select
rango1.Select
Selection.NumberFormat = "General" 'I change the format of the column that has all my dates
'clear the cache
Dim pt As PivotTable
Dim ws As Worksheet
Dim pc As PivotCache
'change the settings
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
Next pt
Next ws
'refresh all the pivot caches
For Each pc In ActiveWorkbook.PivotCaches
On Error Resume Next
pc.Refresh
Next pc
'now select the pivot item i want
Dim pi As PivotItem
Set pt = Sheets("TD Refrigerante").PivotTables("PivotTable2")
'Sets Pivot Table to Manual Sort so you can manipulate PivotItems in PivotField
pt.PivotFields("Fecha").AutoSort xlManual, "Fecha"
'Speeds up code dramatically
pt.ManualUpdate = True
For Each pi In pt.PivotFields("Fecha").PivotItems
If pi.Name = ffan Then
pi.Visible = True
Else
pi.Visible = False
End If
Next pi
pt.ManualUpdate = False
pt.PivotFields("Fecha").AutoSort xlAscending, "Fecha"
Use Caption instead of Name.
For Each pvtItem In ActiveSheet.PivotTables("PivotTable1").PivotFields("Something").PivotItems
If Not pvtItem.Caption = "Example" Then
pvtItem.Visible = False
End If
Next