I am trying to manipulate a slicer for a regular Pivot table in VBA (not PowerPivot), but I cannot reference the VisibleSlicerItemsList. I get an error:
Application-defined or object-defined error
Any idea what I am doing wrong?
Screenshot showing data and pivot table with slicer from test workbook, along with the error message "Application-defined or object-defined error" for the VisibleSlicerItemsList in the Locals window
You can download the test workbook here.
Check the MSDN entry on this property - it states that:
The VisibleSlicerItemsList property is only applicable for slicers that are based on OLAP data sources (SlicerCache.OLAP = True).
In your example you are using a pivot table connected to data in the sheet and not to an OLAP cube.
You can work around it with code like this which iterates the SlicerItems collection of the SlicerCache:
Option Explicit
Sub Test()
Dim objCache As SlicerCache
Dim objItem As SlicerItem
Dim varChoices As Variant
Dim lngCounter1 As Long
Dim lngCounter2 As Long
Set objCache = ThisWorkbook.SlicerCaches("Slicer_Company")
varChoices = Array("1", "3", "5")
' iterate slicers
For lngCounter1 = 1 To objCache.SlicerItems.Count
Set objItem = objCache.SlicerItems(lngCounter1)
'assume not for selection
objItem.Selected = False
'iterate choices to check for activation
For lngCounter2 = 0 To UBound(varChoices)
If objItem.Name = varChoices(lngCounter2) Then
'activate and exit loop
objItem.Selected = True
Exit For
End If
Next lngCounter2
Next lngCounter1
End Sub
Related
When I run this VBA code in macros, it reports
"Run-time error '5941': The requested member of the collection does not exist"
on the highlight line
Sub addColumn()
'
' addColumn
'
'
Application.Templates.LoadBuildingBlocks
Dim myDoc As Document
Set myDoc = Word.ActiveDocument
Dim myTable As Table
With myDoc
iCount = myDoc.Tables.Count
For i = 1 To iCount
Set myTable = myDoc.Tables(i)
myTable.Columns.Add BeforeColumn:=myTable.Columns(6)
Next
End With
End Sub
Could anyone give me some advice?
I wrote this code for dealing with a word.doc which contains lots of tables(606 tables) and other characters. I want to use macros to add a column at the end of each table in the batch. Did I miss something?
If all you want to do is to add a new column after the last column in each table, all you need is:
Sub Demo()
Application.ScreenUpdating = False
Dim Tbl As Table
For Each Tbl In ActiveDocument.Tables
Tbl.Columns.Add
Next
Application.ScreenUpdating = True
End Sub
Alright, VBA masters! Newbie here again. Working with OLAP Cube data.
This time I am stuck on trying to automatically select a slicer item (from a different slicer group), based on a previously selected slicer item from another group.
To give it context, I am trying to select the same person under 2 different slicers. To make things more challenging, the slicers use different descriptors for people - that is "Smith, Bob" is used in one slicer and "123C - Smith, Bob" is used in the other slicer.
Here is my code:
Dim wb As Workbook
Dim slItem As SlicerItem
Dim slItem2 As SlicerItem
Dim sc3 As SlicerCache
Dim sc3L As SlicerCacheLevel
Dim sc4 As SlicerCache
Dim sc4L As SlicerCacheLevel
Set wb = ActiveWorkbook
Set sc3 = wb.SlicerCaches("Slicer_Primary_Account_List_Combo__BI")
Set sc4 = wb.SlicerCaches("Slicer_TM_Hierarchy")
Set sc3L = sc3.SlicerCacheLevels(1)
Set sc4L = sc4.SlicerCacheLevels(3)
sc3L.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
' Select the first person within the Sales Cube slicer
' This selects each slicer item in the Sales Cube and iterates through them
For Each slItem In sc3L.SlicerItems
If slItem.HasData Then ''' This ensures the iteration is only on items with data
sc3.ClearManualFilter
sc3.VisibleSlicerItemsList = Array(slItem.Name)
End If
Next
' Now ensure the same person is also selected within the BM Cube slicer
For Each slItem2 In sc4L.SlicerItems
sc4.ClearManualFilter ''' CODE WORKS UP TO HERE
If slItem2.Value = Mid(slItem.Value, 8, 30) Then ''' I am trying to force the selection on the second slicer by looking for the name match. But this is NOT working. BREAKPOINT.
slItem2.Selected = True
End If
Next
I am getting a run time error 1004 at the Breakpoint. Saying it's an application-defined or object-defined error.
I've been trying to fix this piece of code for too long - and need your expertise!
The ultimate goal is: I only need 1 person selected at each iteration. And I need the same person selected on both slicers.
And GO!
Ok, let's try this:
Option Explicit
Sub Main()
Dim wb As Workbook
Dim slItem As SlicerItem
Dim sc3 As SlicerCache
Dim sc3L As SlicerCacheLevel
Set wb = ActiveWorkbook 'ThisWorkbook is better if this code is run on the same workbook
Set sc3 = wb.SlicerCaches("Slicer_Primary_Account_List_Combo__BI")
sc3L.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
' Select the first person within the Sales Cube slicer
' This selects each slicer item in the Sales Cube and iterates through them
For Each slItem In sc3L.SlicerItems
If slItem.HasData Then ''' This ensures the iteration is only on items with data
sc3.ClearManualFilter
sc3.VisibleSlicerItemsList = Array(slItem.Name)
Testing CStr(slItem.Name)
End If
Next
End Sub
Sub Testing(SalesName As String)
Dim slItem2 As SlicerItem
Dim sc4 As SlicerCache
Dim sc4L As SlicerCacheLevel
Dim wb As Workbook
Dim SalesSplit As Variant
'with this you are getting an array with the number and name being SalesSplit(1) the name
'So taking that SalesName = "123C - Smith, Bob" then SalesSplit(0) will be "123C" and SalesSplit(1) will be "Smith, Bob"
SalesSplit = Split(SalesName, " - ")
Set wb = ThisWorkbook 'if the workbook is the same containing the code
Set sc4 = wb.SlicerCaches("Slicer_TM_Hierarchy")
Set sc3L = sc3.SlicerCacheLevels(1)
Set sc4L = sc4.SlicerCacheLevels(3)
For Each slItem2 In sc4L.SlicerItems
sc4.ClearManualFilter ''' CODE WORKS UP TO HERE
If slItem2.Name = SalesSplit(1) Then ''' I am trying to force the selection on the second slicer by looking for the name match. But this is NOT working. BREAKPOINT.
slItem2.Selected = True
End If
Next
'Continue your code, when this sub ends it will loop through the next item on your sales cube
End Sub
2 subs, the first one "main" will call the second one "Testing".
Step 1 Select a item with data on sales cube.
Step 2 Call the testing procedure passing the selected name from sales cube. Then you select the same item on the second cube and perform your tasks. Once done, back to step 1
I am setting up a dynamic report and would like to filter multiple pivot tables at the same time as I change one cell value. I have no experience in VBA and cannot find anyone within my company that can help.
Since the pivot tables are separate objects, I define them all as different dimensions and point these dimensions to the different pivot tables but the cell that is meant to dictate the pivot table filter stays the same. Below are modified from my google search. Original codes worked fine updating 1 pivot table. After my ignorant attempt at modifying the codes, I ended up with application-defined or object-defined error.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("D1:D2")) Is Nothing Then Exit Sub
Dim pt As PivotTable
Dim Field As PivotField
Dim NewCat As String
Dim pt1 As PivotTable
Dim Field1 As PivotField
Dim NewCat1 As String
Set pt = Worksheets("Sheet1").PivotTables("PivotTable1")
Set Field = pt.PivotFields("Code")
NewCat = Worksheets("Sheet1").Range("D1").Value
Set pt1 = Worksheets("Sheet1").PivotTables("Pivotable2")
Set Field1 = pt1.PivotFields("Code")
NewCat1 = Worksheets("Sheet1").Range("D1").Value
With pt
Field.ClearAllFilters
Field.CurrentPage = NewCat
pt.RefreshTable
End With
With pt1
Field1.ClearAllFilters
Field1.CurrentPage = NewCat1
pt1.RefreshTable
End With
End Sub
I am having some problems in linking an Active X combobox to a Pivot table filter. Basically I will need to have the users to select from the combobox an ID that needs to be linked to the Pivot table filter. I am using the following code:
Private Sub ComboBox1_Change()
Dim sheet As Worksheet
Dim pt As PivotTable
Dim ptField As PivotField
Set sheet = ThisWorkbook.Worksheets("Overview")
Set pt = sheet.PivotTables("Main")
Set ptField = pt.PivotFields("CustomersId")
ptField.ClearAllFilters
ptField.CurrentPage = Me.ComboBox1.Value
End Sub
The error I get is: "Unable to get the PivotFields property of the PivotTable Class".
Any idea of what is wrong with the above code? Something that I m missing?
Thank you in advance
I am very new in EXCEL (especially in VBA). I try to write logic that:
go to all open books, if some book has sheet with name "Test", it should take data from named range "Table" and then append it to the Table1 from sheet ALLDATA in book ALLDATABOOK. I try to write this, can someone help me?
Here is my code:
Private Sub CommandButton1_Click()
Dim book As Object
Dim lst As ListObject
Dim iList As Worksheet
For Each book In Workbooks
For Each iList In book.Sheets
If iList.Name = "Test" Then
book.Sheets(iList.Name).Activate
Range("Table").Select
End If
Next
Next
End Sub
Try this (written for Excel 2007+, may not work for earlier versions)
Private Sub CommandButton1_Click()
Dim book As Workbook
Dim lst As ListObject
Dim iList As Worksheet
Dim Rng As Range
Dim wbAllDataBook As Workbook
Dim shAllData As Worksheet
' Get reference to ALLDATA table
Set wbAllDataBook = Workbooks("ALLDATABOOK.xlsm") '<-- change to suit your file extension
Set shAllData = wbAllDataBook.Worksheets("ALLDATA")
Set lst = shAllData.ListObjects("Table1")
For Each book In Workbooks
' Use error handler to avoid looping through all worksheets
On Error Resume Next
Set iList = book.Worksheets("Test")
If Err.Number <> 0 Then
' sheet not present in book
Err.Clear
On Error GoTo 0
Else
' If no error, iList references sheet "Test"
On Error GoTo 0
' Get Reference to named range
Set Rng = iList.[Table]
' Add data to row below existing data in table. Table will auto extend
If lst.DataBodyRange Is Nothing Then
' Table is empty
lst.InsertRowRange.Resize(Rng.Rows.Count).Value = Rng.Value
Else
With lst.DataBodyRange
.Rows(.Rows.Count).Offset(1, 0).Resize(Rng.Rows.Count).Value = Rng.Value
End With
End If
End If
Next
End Sub
Update:
To use with Excel 2003 replace
If lst.DataBodyRange Is Nothing Then
with
If Not lst.InsertRowRange Is Nothing Then