So I would like to retrieve the selected items from my "Department" slicer and store them in a string. However When I test this I only get the last item and its not even one selected. This works great for setting the DepartmentX slicer with the same items from Department however I would like to store only the selected items in a string. Any help would be greatly appreciated
here is what I have so far
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim PT1 As PivotTable, PT2 As PivotTable
Dim slc1 As Slicer, slc2 As Slicer
Dim slcCache1 As SlicerCache, slcCache2 As SlicerCache
Dim slcItem1 As SlicerItem, slcItem2 As SlicerItem
Dim slicer_data As String
If Sh.Name = "GP YTD - Tooling (FYE 2016)" Then
Set PT1 = Sheets("Sheet1").PivotTables
("PivotTable2") '(1)
Set slc1 = PT1.Slicers("Department") '(1)
Set slcCache1 = slc1.SlicerCache
Set PT2 = Sheets("Sheet2").PivotTables
("PivotTable3") '(2)
Set slc2 = PT2.Slicers("DepartmentX") '(2)
Set slcCache2 = slc2.SlicerCache
slcCache2.ClearManualFilter
For Each slcItem1 In slcCache1.SlicerItems
slcCache2.SlicerItems(slcItem1.Name).Selected = slcItem1.Selected
slicer_data = slcItem1.Name
Application.EnableEvents = True
Next slcItem1
MsgBox "Selected" & slicer_data
End If
End Sub
Modify the last part to this:
For Each slcItem1 In slcCache1.SlicerItems
slcCache2.SlicerItems(slcItem1.Name).Selected = slcItem1.Selected
If slcItem1.Selected Then slicer_data = slicer_data & "," & slcItem1.Name
Application.EnableEvents = True
Next slcItem1
MsgBox "Selected" & Mid$(slicer_data, 2)
Related
I have a particular problem and couldn't find any solution anywhere on the internet.
So I have a pivot table which is connected to 6 slicers and also a chart which data range is dependent on pivot table values.
I've made a macro which updates chart scales everytime a value in any of the worksheet cells is changed. Here is the macro:
Public Sub worksheet_Change(ByVal Target2 As Range)
If ActiveSheet.Name = "Dashboard" Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DataEntryMode = xlOff
'Chart_axis Macro
Sheets("Dashboard").ChartObjects("Chart 9").Activate
If ActiveSheet.Range("B19") = "excluding CE" Then
ActiveChart.Axes(xlValue).MinimumScale = Range("E3").Value
ActiveChart.Axes(xlValue).MaximumScale = Range("E4").Value
Else
ActiveChart.Axes(xlValue).MinimumScale = Range("A3").Value
ActiveChart.Axes(xlValue).MaximumScale = Range("A4").Value
End If
ActiveChart.Refresh
ActiveSheet.Range("B18").Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If
End Sub
In order to work as intended i also had to made a function which reads the active elements of a slicer:
Public Function GetSelectedSlicerItems(SlicerName As String) As String
Application.Volatile
Set coll = New Collection
Dim cache As Excel.SlicerCache
Dim i As Integer
Set cache = ActiveWorkbook.SlicerCaches(SlicerName)
Dim sItem As Excel.SlicerItem
Dim result As String
For Each sItem In cache.SlicerItems
If sItem.Selected And sItem.HasData Then
'Debug.Print sItem.Name
'Debug.Print sItem.HasData
'GetSelectedSlicerItems = (sItem.Name)
coll.Add sItem.Name
End If
Next sItem
For i = 1 To coll.Count
'Debug.Print coll(i)
result = result & coll(i) & ", "
Next i
result = Left(result, Len(result) - 2)
GetSelectedSlicerItems = result
End Function
My problem is that while the value of the function always updates when the slicer item is changed, the macro only does it randomly about 50% of the time.
Screenshot of my report:
The formulas containing the selected slicer items function are on the top right.
So do you have any idea how to make it work 100% of the time?
Thanks in advance,
Alan
Edit: i forgot to add that it's only the issue if only one slicer is highlited. When i select multiple slicers (with ctrl+click) it always works.
The following is the code i am using to update the value of my slicer.
Sub country_select()
Application.ScreenUpdating = False
country_selected = ActiveSheet.Shapes(Application.Caller).Name
ActiveWorkbook.SlicerCaches("Slicer_Country").ClearManualFilter
For Count = 1 To 13 'countries
country = Sheet5.Range("E2").Offset(Count, 0).Value
If country = country_selected Then
ActiveWorkbook.SlicerCaches("Slicer_Country").SlicerItems(country).Selected = True
Else
ActiveWorkbook.SlicerCaches("Slicer_Country").SlicerItems(country).Selected =
False
End If
Next Count
Application.ScreenUpdating = True
End Sub
The country variable is not updating its value(only taking empty value).
I don't understand the reason for this.
I am trying to link a map to a macro hence the input.
I'm not sure why you need to interate through the range E3:E14. If all you want to do is to set the Slicer to show the item corresponding to the shape the user has selected, I would just use something like this:
Option Explicit
Sub country_select()
Dim si As SlicerItem
Dim Country As String
Dim sc As SlicerCache
Application.ScreenUpdating = False
Country = ActiveSheet.Shapes(Application.Caller).Name
Set sc = ActiveWorkbook.SlicerCaches("Slicer_Country")
With sc
.ClearAllFilters
For Each si In sc.SlicerItems
If si.Name <> Country Then si.Selected = False
Next si
End With
Application.ScreenUpdating = True
End Sub
Note that if the slicer was for a PivotTable (and not for a Table) I would set the .ManualUpdate propery of the PivotTable to TRUE before the loop, and to FALSE after, so that the PivotTable didn't try to update after each and every SlicerItem is selected.
And if this was for a PivotTable (and not for a Table) there is no need to iterate over a Slicer at all (which is inefficient/slow). Instead, just put the Country field in the Pivot as a PageField, and just set the .CurrentPage of the PageField directly, like so:
Sub FilterPivot()
Dim pf As PivotField
Set pf = ActiveSheet.PivotTables("PivotTable1").PivotFields("Country")
pf.CurrentPage = Application.Caller
End Sub
Hi I have encountered problem with my listbox data in my Userform
When I try to change the source file where my listbox connected it doesn't seems to change
It was showing good data at first but when I try to click RUN DATE button
It doesn't go with the Value in my Range that is being set as My key for sorting
Here is my code for RUN DATE BUTTON for sorting Ascending and Descending
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
End Sub
And this is how I initialize the value in my listbox
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
'Load Worksheet Range directly to a ListBox:
Dim var As Variant
var = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = var
End Sub
Is there a way to refresh my listbox? Listbox1.refresh something like that?
Note: I don't need to close my Userform and open again to see the updated listbox
so while the Userform is in active mode(Open) I can directly update the listbox value..
Thanks
Instead of using var and assigning the data to List from var, you can use Named Range of data in the sheet and assign the property
ListBox1.RowSource = "Name of the Range"
Every time you want to refresh the listbox just use the above assignment in your code and it will work. If you find any difficulty please let me know.
You could add a refresh procedure, then call it in your OnClick event procedure for the button.
Note, I haven't tested this code, but it should do what your original question asked.
Private Sub UserForm_Initialize()
'set ListBox properties on initialization of UserForm
Set sht = ThisWorkbook.Worksheets("combobox_value")
lastRow_combobox_column = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "100"
.ColumnHeads = False
.ControlTipText = True
End With
RefreshListbox
End Sub
Private Sub CommandButton1_Click()
Application.EnableEvents = False
Worksheets("combobox_value").Activate
Dim strDataRange As Range
Dim keyRange As Range
Set strDataRange = Range("I2:L4")
Set keyRange = Range("I2:I4")
If Range("M2").Value = "D" Then
strDataRange.Sort Key1:=keyRange, Order1:=xlDescending
Range("M2").Value = "A"
Else
strDataRange.Sort Key1:=keyRange, Order1:=xlAscending
Range("M2").Value = "D"
End If
Application.EnableEvents = True
RefreshListbox
End Sub
Private Sub RefreshListbox()
Me.ListBox1.Clear
'Load Worksheet Range directly to a ListBox:
Dim ListRange As Range
ListRange = Sheets("combobox_value").Range("I2:L" & lastRow_combobox_column)
Me.ListBox1.List = ListRange
End Sub
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 need help with some VBA code. I have an AgeRange slicer and I have a working script that inserts a row, adds a timestamp, and then reports the slicer selections.
I'd like to add something to this that will SKIP the process if ALL the items in the slicer are selected (True).
Is there something that I can insert that says "If the slicer hasn't been touched (all items are true), then end sub".
Here's what I have for code so far:
Dim cache As Excel.SlicerCache
Set cache = ActiveWorkbook.SlicerCaches("Slicer_AgeRange")
Dim sItem As Excel.SlicerItem
For Each sItem In cache.SlicerItems
If sItem.Selected = True Then xAge = xAge & sItem.Name & ", "
Next sItem
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")
Range("B1").Select
ActiveCell.FormulaR1C1 = xAge
Range("C1").Select
End Sub
Any help is greatly appreciated!
This is a bit more than you asked for, but I figured I would share since I just wrote this for my own use. It clears all slicers physically located on a worksheet only if they are filtered (not all selected). For your question, the good bit is the for each item loop. and the line right after it.
Sub clearWorksheetSlicers(ws As Worksheet)
'clears all slicers that have their shape on a specific worksheet
Dim slSlicer As Slicer
Dim slCache As SlicerCache
Dim item As SlicerItem
Dim hasUnSel As Boolean
For Each slCache In ThisWorkbook.SlicerCaches
For Each slSlicer In slCache.Slicers
If slSlicer.Shape.Parent Is ws Then
For Each item In slCache.SlicerItems
If item.Selected = False Then
hasUnSel = True
Exit For
End If
Next item
If hasUnSel = True Then slCache.ClearManualFilter
hasUnSel = False
End If
Next slSlicer
Next slCache
End Sub
Nvm. I got it on my own. :)
Dim cache As Excel.SlicerCache
Dim sName As Slicers
Dim sItem As Excel.SlicerItem
Dim xSlice As String
Dim xName As String
For Each cache In ActiveWorkbook.SlicerCaches
xName = StrConv(Replace(cache.Name, "AgeRange", "Ages")
xCheck = 0
For Each sItem In cache.SlicerItems
If sItem.Selected = False Then
xCheck = xCheck + 1
Else
xCheck = xCheck
End If
Next sItem
If xCheck > 0 Then
For Each sItem In cache.SlicerItems
If sItem.Selected = True Then
xSlice = xSlice & sItem.Caption & ", "
End If
Next sItem
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B1").Select
ActiveCell.FormulaR1C1 = xName & ": " & xSlice
xSlice = ""
End If
Next cache
Range("A1").Select
ActiveCell.FormulaR1C1 = Format(Now(), "MM-DD-YYYY HH:MM AM/PM")
End Sub
The code in this thread by Dallas Frank looks like it should work, and all the properties explicitly called do exist but for some reason in my pivot table the SlicerItems collection is empty. I have to check each SlicerItem via
SlicerCache.SlicerCacheLevels.Item(1).SlicerItems
This replacement is not precisely what the original requestor asked but it is illustrative of the use of SlicerCacheLevel that got me where I needed to be when SlicerCache.SlicerItems turned out not to exist
Sub AllSlicersSelected(WorksheetWithPT As Worksheet)
Dim SlicerItems As SlicerItems
Dim SlicerItem As SlicerItem
Dim SlicerCaches As SlicerCaches
Dim SlicerCache As SlicerCache
Dim SlicerCacheLevel As SlicerCacheLevel
Dim Slicer As Slicer
Dim strSlicerItemsNotSelected As String
Dim bHaveWhatWeNeed As Boolean
Dim vSlicerItemsToSelect As Variant
Set SlicerCaches = ThisWorkbook.SlicerCaches
For Each SlicerCache In SlicerCaches
For Each Slicer In SlicerCache.Slicers
If Slicer.Shape.Parent Is WorksheetWithPT Then
bHaveWhatWeNeed = True
Exit For
End If
Next
If bHaveWhatWeNeed Then
Exit For
End If
Next
For Each SlicerCacheLevel In SlicerCache.SlicerCacheLevels
For Each SlicerItem In SlicerCacheLevel.SlicerItems
If Not SlicerItem.Selected Then
strSlicerItemsNotSelected = strSlicerItemsNotSelected & Chr(0)
End If
Next
Next
If Len(strSlicerItemsNotSelected) > 0 Then
vSlicerItemsToSelect = Split(Mid(strSlicerItemsNotSelected, 2), Chr(0))
For Each SlicerItem In vSlicerItemsToSelect
SlicerItem.Selected = True
Next
End If
End Sub
Using Dallas Franks solution, I ran into a 1004 issue where it was showing a method/object error. Could be because I am using PowerQuery to generate Power Pivots and immediately found that sometimes you must use slicer cache levels.
Dallas Franks solution was too good to start from the beginning so I found a way to slightly change it to use SlicerChacheLevel(s) and it works very well!
Sub clearWorksheetSlicers(ws As Worksheet)
'clears all slicers that have their shape on a specific worksheet
Dim slSlicer As Slicer
Dim slCache As SlicerCache
Dim item As SlicerItem
Dim hasUnSel As Boolean
Dim sllvl As SlicerChacheLevel
For Each slCache In ThisWorkbook.SlicerCaches
For Each slSlicer In slCache.Slicers
If slSlicer.Shape.Parent Is ws Then
For Each sllvl In slCache.SlicerCacheLevels
For Each item In sllvl.SlicerItems
If item.Selected = False Then
hasUnSel = True
Exit For
End If
Next item
Next sllvl
If hasUnSel = True Then slCache.ClearManualFilter
hasUnSel = False
End If
Next slSlicer
Next slCache
End Sub