VBA Excel pre-select items in a multicolumn multiselect listbox - excel

I am trying to load a listbox with items with two columns, check each entry against a spreadsheet, and select the row if that entry is found.
The result is loading a customer list, identifying and selecting the items already on a mailing list, allowing the user to edit the selection and updating the spreadsheet with the updated selection.
I tried to do the check within the loading of the listbox, but since I was tripping with errors I separated it out to make things clearer, the error occurs in the code below on the line CRM_Edit_Groups.ListBox1(j).Selected = True
With Rows(1)
Set c = .Find(What:=showgroup, LookIn:=xlValues, LookAt:=xlWhole)
End With
For i = 0 To wk.Sheets("temp").UsedRange.Rows.count + 1
code = wk.Sheets("temp").Range("a" & mycount)
company_name = wk.Sheets("temp").Range("b" & mycount)
CRM_Edit_Groups.ListBox1.ColumnCount = 2
CRM_Edit_Groups.ListBox1.ColumnWidths = "40;80"
CRM_Edit_Groups.ListBox1.AddItem
CRM_Edit_Groups.ListBox1.list(i, 0) = code
CRM_Edit_Groups.ListBox1.list(i, 1) = company_name
mycount = mycount + 1
Next
For j = 0 To Me.ListBox1.ListCount - 1
check = Me.ListBox1.list(j, 0)
With Columns(c.Column)
Set d = .Find(What:=check, MatchCase:=False)
End With
If Not d Is Nothing Then CRM_Edit_Groups.ListBox1(j).Selected = True
If Not d Is Nothing Then Set d = Nothing
Next
I've included the code for loading the listbox, as well as the loop to check each one against the spreadsheet, I've tried many combinations including:
CRM_Edit_Groups.ListBox1(j,0).Selected = True
CRM_Edit_Groups.ListBox1(j,1).Selected = True
CRM_Edit_Groups.ListBox1(j.row).Selected = True
...but all result in "Run-time error '424': Object required", I know I am not managing to work with the row here but searching the site and google I just find pages of information on how to read the selected items from a listbox and not much on how to select during initialization.

You should use
CRM_Edit_Groups.ListBox1.Selected(j) = True
Also, make sure that your list allows multiple selection. Select your listbox in userform window and go to object properties. There find property MultiSelect and chose option 1.

Related

Reading text in Table Control

I have a problem with SAP VA02 where I want to identify the row line in which a specific label is. In this case the label/text is "Cust. expected price".
I am trying to change the data next to this row, problem is that it is not always the same row, sometimes it is 16, 18, etc.
I am trying to find a way to loop through each row in column 2 in the structure, read the text, and find which row the label is in, then use the row as a variable to paste the price in the correct cell. I have pasted some functioning code below.
What I am doing is inputting the correct price here:
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSUBSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN/txtKOMV-KBETR[3,16]").Text = Price
My main question is how to read what text is in each cell for example session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSUBSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN/txtKOMV-KBETR[2,16]")
I can probably figure out the rest from there. I haven't been able to find much regarding this specific structure, any input is appreciated. I will also post a screenshot of the page for reference. Thank you!
Sub OrderRelease()
Dim Order As String
Dim RowCount As Integer
Dim Item As Integer
Dim sh As Worksheet
Dim rw As Range
Dim Sroll As Integer
Dim Price As Double
On Error Resume Next
RowCount = 0
Set sh = ActiveSheet
For Each rw In sh.Rows
If sh.Cells(rw.Row, 6).Value = "" Then
Exit For
End If
RowCount = RowCount + 1
Next rw
If Not IsObject(SAPGuiApp) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set SAPGuiApp = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = SAPGuiApp.Children(0)
End If
If Not IsObject(SAP_session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject SAP_session, "on"
WScript.ConnectObject SAPGuiApp, "on"
End If
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").Text = "/nva02"
session.findById("wnd[0]").sendVKey 0
For i = 2 To RowCount
Order = Cells(i, "F")
session.findById("wnd[0]/usr/ctxtVBAK-VBELN").Text = Order
session.findById("wnd[0]/usr/ctxtVBAK-VBELN").caretPosition = 9
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[1]/tbar[0]/btn[0]").press
Continue:
Item = Cells(i, "G") / 10 - 1
Scroll = Item - 1
Price = Cells(i, "H")
Set sub = session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_OVERVIEW/tabpT\02/ssubSU" _
& "BSCREEN_BODY:SAPMV45A:4401/subSUBSCREEN_TC:SAPMV45A:4900")
Set tbl = sub.findById("tblSAPMV45ATCTRL_U_ERF_AUFTRAG")
tbl.verticalScrollbar.Position = Scroll
tbl.getAbsoluteRow(Item).Selected = True
tbl.findById("txtVBAP-POSNR[0,8]").SetFocus
tbl.findById("txtVBAP-POSNR[0,8]").caretPosition = 4
sub.findById("subSUBSCREEN_BUTTONS:SAPMV45A:4050/btnBT_PKON").press
Set tbl2 = session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\05/ssubSU" _
& "BSCREEN_BODY:SAPLV69A:6201/tblSAPLV69ATCTRL_KONDITIONEN")
tbl2.verticalScrollbar.Position = 8
'The below line is what I need to find. In this case, Cust. expected price would be 2,16,
'but I have not found a way to actually read the text in that cell.
tbl2.findById("txtKOMV-KBETR[3,16]").Text = Price
tbl2.findById("txtKOMV-KBETR[3,16]").SetFocus
tbl2.findById("txtKOMV-KBETR[3,16]").caretPosition = 16
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\11").Select
session.findById("wnd[0]/usr/tabsTAXI_TABSTRIP_ITEM/tabpT\11/ssubSU" _
& "BSCREEN_BODY:SAPMV45A:4456/cmbVBAP-ABGRU").Key = " "
session.findById("wnd[0]/tbar[0]/btn[3]").press
session.findById("wnd[0]/usr/btnBUT2").press
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[0]").sendVKey 0
If Cells(i, "F") = Cells(i + 1, "F") Then
i = i + 1
GoTo Continue
End If
session.findById("wnd[0]").sendVKey 11
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/btnSPOP-VAROPTION1").press
Next i
End Sub
Here is how to refer to a value of a cell in a given row and a given column, which are both provided in variables:
row = 0
column = 1
cellText = session.findById(".../tblXXXXX/columnFieldName[" & column & "," & row & "]").Text
Another solution is to use the method GetCell on the Table Control object:
cellText = session.findById(".../tblXXXXX").GetCell(row,column).Text
NB: notice that row and column arguments are switched.
To know what values to use for ".../tblXXXXX/columnFieldName[...], the easiest way is to record a script, by simply moving the cursor to the desired column. The generated script will return something like that (test with the demo program DEMO_DYNPRO_TABCONT_LOOPFLIGHTS):
session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS/ctxtDEMO_CONN-CITYFROM[2,1]").setFocus
session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS/ctxtDEMO_CONN-CITYFROM[2,1]").caretPosition = 1
The row number corresponds to the order among the visible rows, starting from 0 (0 = first visible row). The last visible row has the number equals to the Table Control property VisibleRowCount minus 1. The rows which are not visible (above and below) can be accessed by making your script scroll vertically, for more information about scrolling programatically see below chapter.
The column number is based on the order of columns shown in the Table Control, whatever the columns are immediately visible or visible after horizontal scrolling. The script doesn't need to perform horizontal scrolling to read the values of non-visible columns. 0 is the leftmost column, and the rightmost column has the number equals to the two properties of the Table Control Columns.Count minus 1.
The list of columns and their order may vary according to the active Table Control configuration. You may wish to determine the column number based on the column name at run time, for that see below chapter.
There may be other columns proposed via the Table Control administrator function, with the "hidden" checkbox selected. SAP GUI Scripting completely ignores these columns. If you need to work with them, you must call the table control method ConfigureLayout to display the administrator screen, and then you can work with the settings as you do with any other screen.
Scrolling the rows
For a Table Control, SAP GUI Scripting knows only the data in the lines which are currently visible on the screen, because for performance reason the backend ABAP program sends only these lines to the frontend. SAP GUI Scripting can't know the values from the invisible lines. It's required that the script scrolls vertically to obtain the other rows. Attention, scrolling means the reloading of the whole screen, so the screen elements need to be re-instantiated. The following example scrolls the whole list to display all the values in the first column (use of the demo program DEMO_DYNPRO_TABCONT_LOOPFLIGHTS):
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
' Make the first row visible (show the top of the list) -> that calls the back-end system and screen is reloaded.
' ATTENTION: when the back-end is called, to continue working with screen elements, they must be re-instantiated.
tbl.VerticalScrollbar.Position = 0
TextsOfAllCellsInColumnZero = ""
Do While True
' Re-instantiate the Table Control element (mandatory each time the back-end is called)
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
visibleRow = 0
currentScrollbarPosition = tbl.VerticalScrollbar.Position
While visibleRow < tbl.VisibleRowCount And currentScrollbarPosition <= tbl.VerticalScrollbar.Maximum
TextsOfAllCellsInColumnZero = TextsOfAllCellsInColumnZero & tbl.GetCell(visibleRow,0).Text & Chr(10)
visibleRow = visibleRow + 1
currentScrollbarPosition = currentScrollbarPosition + 1
Wend
If currentScrollbarPosition > tbl.VerticalScrollbar.Maximum Then
Exit Do
End If
tbl.VerticalScrollbar.Position = currentScrollbarPosition
Loop
MsgBox TextsOfAllCellsInColumnZero
Note that this example is suitable to a small number of pages. In many other situations, there are many more pages, for an action like searching a line containing a given value, it would be much more performing to click an existing button to perform a back-end search of this value. The right page would be immediately be displayed.
Determine the column number from the column name at run time
As explained above, the column number may vary depending on the order of columns and on hidden columns. If they vary in an undetermined way at run time, the following code allows to determine the column number based on the column name (note that the lower case prefix of the field name is to be removed, like "ctxt" in "ctxtDEMO_CONN-CITYFROM"), but it works only if there's at least 1 row (no solution found if it's needed when the Table Control is empty):
Set tbl = session.findById("wnd[0]/usr/tblDEMO_DYNPRO_TABCONT_LOOPFLIGHTS")
column = GetColumnNumberByName(tbl,"DEMO_CONN-CITYFROM")
msgbox tbl.GetCell(row,column).text
Function GetColumnNumberByName( TableControl, ColumnName )
If TableControl.Rows.Count > 0 Then
For i = 0 To TableControl.Columns.Count - 1
If TableControl.Columns(i)(0).Name = ColumnName Then
GetColumnNumberByName = i
Exit Function
End If
Next
End If
GetColumnNumberByName = -1
End Function
Appendix
For more information, please refer to the documentation of the "GuiTableControl Object" in the SAP Library.
NB: if you look at other questions, be aware that a Table Control (GuiTableControl) is completely unrelated to a Grid View (GuiGridView), so don't be confused.

Is there a way to select a listbox (similar to clicking on it with mouse?)

I'm writing some VBA code for a user form. The values are selected in a listbox on the left (LB_Participants). Then "select" is pressed and the values are copied to a listbox on the right (LB_Output). I then want VBA to go through all these items seperatly in the LB_Output and look up other associated data from another worksheet. Problem I'm having is that somethimes the values are not selected. I check it with a messagebox and from time to time its blank. Then no associated data can be retrieved ofcourse.
Before starting to fill in the userform, if I just click once on LB_Output (even without selecting any value) I don't have this problem. Many people will be using the userform so I don't want to explain tot them that they have to click first on the listbox before continuing... Is there something I'm not doing right?
Blank Msgbox
Dim ListCount As Integer
Dim z As Integer
ListCount = UserForm2.LB_Output.ListCount
For z = 0 To ListCount - 1
UserForm2.LB_Output.Selected(z) = True
TextString = UserForm2.LB_Output.Value
MsgBox (TextString)
'Split Participants into seperate names and copy them to data sheet
WArray() = Split(TextString, ";")
For Counter = LBound(WArray) To UBound(WArray)
Dim LRNames As Integer
If IsEmpty(Sheets("Data").Range("A1")) = True Then
LRNames = 0
Else
LRNames = Sheets("Data").Range("A" & Application.Rows.Count).End(xlUp).Row
End If
Strg = WArray(Counter)
Sheets("Data").Cells(LRNames + 1, 1) = Trim(Strg)
Next Counter
Next z
Not sure I understand, but think you want to loop through all the items in LB_Output and process them regardless if selected or not - all the selection was done in the other listbox and those items moved to LB_Output.
This does not explicitly select each item, simply gets data from it.
For z = 0 to UserForm2.LB_Output.Listcount -1
' If you want to select the item to show 'progress' through the list,
' uncomment ...
' LB_Output.listindex = z
' The next line will still work as is
TextString = UserForm2.LB_Output.List(z)
'// Do processing with this item
Next

De-duplicate VBA scripting dictionary

I've got three combo boxes in a workbook that I want to daisy chain together. Item lists for each combo box refresh when you hit the down arrow on the keyboard after clicking the drop down button on the combo box. The second combo box list is dependent on the selection made in the first combo box. I've built these using scripting dictionaries.
strCustComboBox is the value in the previous combo box that the current combo box should be dependent on.
rngProject is looking at a range with lots of quote IDs in it. I offset from this column to the column where the values for the previous combo box are held and if this value is equal to strCustComboBox then add rngCompany value to the scripting dictionary
I'm running into a problem in the loop where I am trying to de-duplicate the rngCompany values written into the scripting dictionary that is used to build the list to be shown in the combo box. My code is below.
Sub UpdateComboBox1FromDashData()
Dim strCustComboBox As MSForms.ComboBox
Dim strComboBox As MSForms.ComboBox
Dim rngCompany As Range
Dim rngProject As Range
Dim d As Object, c As Variant, i As Long
Worksheets("QuoteEditor").Unprotect "xxxx"
Application.ScreenUpdating = False
Set strCustComboBox = ThisWorkbook.Worksheets("QuoteEditor").ComboBox4
Set strComboBox = ThisWorkbook.Worksheets("QuoteEditor").ComboBox1
If strCustComboBox = "" Then
MsgBox "Please select a project first", vbOKCancel
Else
End If
ThisWorkbook.Worksheets("DashboardData").Select
Call FindLastRow("A", "10")
Set d = CreateObject("Scripting.Dictionary")
c = Range("A10:A" & strLastRow)
Set rngProject = ThisWorkbook.Worksheets("DashboardData").Range("A10:A" & strLastRow)
i = 1
For Each rngCompany In rngProject
If UCase(rngCompany.Offset(, 7).Value) = UCase(strCustComboBox) Then
If d.exists(rngCompany) = True Then
Else
d.Add rngCompany, i
i = i + 1
End If
Else
End If
Next rngCompany
For Each Item In d
strComboBox.AddItem (Item)
Next Item
I think where I am using d.exists(rngCompany) is wrong but I'm not sure. When the subroutine finishes I still get duplicate data return to the combo box list.
I've also tried the code below as per the suggested duplicate thread:
With d
For Each rngCompany In rngProject
If UCase(rngCompany.Offset(, 7).Value) = UCase(strCustComboBox) Then
If Not .exists(rngCompany) Then
d.Add rngCompany, Nothing
Else
End If
End If
Next rngCompany
End With
Can anyone see where either of these are going wrong?
You hid the answer to this in your own question (emphasis mine):
where I am trying to de-duplicate the rngCompany values
There is no way for d.Exists(rngCompany) to return true the way that you have this written, because you are keying the Dictionary on the range, not its contents. Since the items you are testing are part of the iteration For Each rngCompany In rngProject, you are guaranteed to have only distinct ranges.
The solution is trivial - you need to explicitly call the default member of rngCompany:
If Not d.Exists(rngCompany.Value) Then
d.Add rngCompany.Value, i
i = i + 1
End If

Remove items from list box by selecting a different item using excel-vba

I apologise now as I am an absolute beginner (also my pictures and code haven't been generalised).
I have a drop down list box in Excel, populated by a range I selected whilst inside excel (ie right click the ActiveX Control after it has been placed and alter the properties). I would like it so that if certain items in the list are selected, other items are removed from the list so that they cannot be selected. Eg. there is a list A, B, and C, but upon a user selecting A, B disappears from the list.
My code is as follows. This first part codes for the drop down list
Sub Rectangle1_Click()
Dim SelShp As Shape, ListShp As Shape, SelList As Variant, i As Integer
Set SelShp = Sheet8.Shapes(Application.Caller)
Set ListBx = Sheet8.ListBox1
If SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers" Then
ListBx.Visible = True
SelShp.TextFrame2.TextRange.Characters.Text = "Set Buffers"
Else
ListBx.Visible = False
SelShp.TextFrame2.TextRange.Characters.Text = "Select Buffers"
For i = 0 To Sheet8.ListBox1.ListCount - 1
If Sheet8.ListBox1.Selected(i) = True Then
SelList = SelList & "; " & Sheet8.ListBox1.List(i)
End If
Next i
If SelList <> "" Then
Range("ListBox1Output") = Right(SelList, Len(SelList) - 1)
Else
Range("ListBox1Output") = ""
End If
End If
End Sub
This second code is what is supposed to remove items from the list
Private Sub ListBox1_Change()
If Sheet8.ListBox1.Selected(0) Then
Sheet8.ListBox1.RemoveItem 1
End If
End Sub
The problem is, when I try it out I get a run-time error '-2147467259 (80004005)': Unspecified error., and if I try and debug it highlights the 'Sheet8.ListBox1.RemoveItem 1', but I just don't know enough to know what I'm doing wrong. Any help would be much appreciated, and I'm sorry if I'm missing something really simple.
Edit: I've been working on this since I posted, and have found some solutions, but run into other roadblocks.
My first problem was that the .RemoveItem method wasn't doing anything. Turns out if a ListBox is populated by using the .ListFillRange method, .RemoveItem won't work – a ListBox has to be populated by using .AddItem if I later want to .RemoveItem.
After I worked that out, I decided to try and do what I want with simpler data:
I have 2 Listboxes and I populate one of them with data. Upon selecting an item in ListBox1, that item is copied into ListBox2, and it is removed from ListBox1. Also, if certain items in ListBox1 are selected, other items are removed from the listbox so that they cannot be selected. Eg. there is a list A, B, and C, but upon a user selecting A, B disappears from the list.
I have got my code to the point where it works in certain situations. Unfortunately, the sequence of the items is important, and for some reason, for certain sequences of items, the code does not work as expected – eg my generalised items happen to be: Germany, India, France, USA, England. Upon selecting 'Germany', this item appears in ListBox2, it is removed from ListBox1, and also, 'France' is removed from ListBox1. This works fine, until the items are put in alphabetical order, at which point upon selecting 'Germany', this item appears in ListBox2, it is removed from ListBox1, 'France' is removed from ListBox1, AND India and USA are moved into ListBox2...?? It's as if once 'France' has been deleted, whatever was below it is selected and runs through the first 2 loops of the ListBox1_Change() sub for some reason. Interrupting it with a messagebox works for some reason, but I can't work out how to interrupt it without using the messagebox...
My code is as follows, with some comments on what I tried included in it.
Populate ListBox1 with items in random positions
Sub Populate_ListBox1()
'Clear LB1 before populating it
Sheet1.ListBox1.Clear
Sheet1.ListBox2.Clear
Sheet1.ListBox1.AddItem "Germany"
Sheet1.ListBox1.AddItem "India"
Sheet1.ListBox1.AddItem "France"
Sheet1.ListBox1.AddItem "USA"
Sheet1.ListBox1.AddItem "England"
End Sub
Try to move selected ListBox1 items while changing what items are in ListBox1
Private Sub ListBox1_Change()
'Variable Declaration
Dim iCnt As Integer
Dim jCnt As Integer
Dim kCnt As Integer
'Move Selected Item from Listbox1 to Listbox2
For iCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(iCnt)
End If
Next
'Clear Selected Item from Listbox1
For iCnt = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(iCnt) = True Then
Me.ListBox1.RemoveItem iCnt
'Me.ListBox1.Selected(iCnt) = False 'Nope
'Exit For
End If
Next
'If Germany is in Listbox2, then remove France from LB1
For kCnt = 0 To Me.ListBox2.ListCount - 1
If Me.ListBox2.Column(0, kCnt) = "Germany" Then
For jCnt = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Column(0, jCnt) = "France" Then
Me.ListBox1.RemoveItem jCnt
'Me.ListBox1.Locked = True 'Nope
'Me.ListBox1.Enabled = False 'Nope
'Me.ListBox1.ListIndex = -1 'This crashes excel...
'MsgBox "blah" 'For some reason this works >.<
Exit Sub
End If
Next jCnt
End If
Next
End Sub
I'd really appreciate help with this, and would even take advice on using a different program that would work with excel (trying to alter items in a listbox based upon their index, which changes, rather than on their values is a nightmare)

Select multiple items in a slicer

I have working code which selects single items from a slicer, however it doesn't work for multiple items.
The selection is set up by reading which cells in a range are in bold, and populating an array of strings, STP(46), populating up until STP(k). This works fine.
Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are. This works for one selection but not for multiple selections - it erroneously selects all items up until the last item to be selected.
With ActiveWorkbook.SlicerCaches("Slicer_STP_Name")
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Selected And .SlicerItems(i).Caption <> STP(j) Then .SlicerItems(i).Selected = False
Next j
Next i
For i = 1 To .SlicerItems.Count
For j = 1 To k
If .SlicerItems(i).Caption = STP(j) Then .SlicerItems(i).Selected = True: Exit For
Next j
Next i
End with
So instead of selecting, say, the 2nd and 4th item in the slicer, it selects the 1st, 2nd, 3rd, 4th, and deselects the rest.
I need to use a looped technique like this because I need to be able to use this code with multiple slicers with different cache names but the same list of items.
I've looked everywhere, and the code above is even from a solution from another question on here. Any help greatly appreciated!
You can use a dictionary to make the process a little more smooth
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
If .SlicerItems(i).Selected And Not stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = False
End If
Next i
For i = 1 To .SlicerItems.Count
If stp.Exists(.SlicerItems(i).Caption) Then
.SlicerItems(i).Selected = True
End If
Next i
End With
I'm not totally clear on why you need the first loop. I'm reading "Then the code is supposed to deselect all items in the slicer which aren't in STP, and select those which are." as "select only those otems in STP and deselect all others" which this reduced code will do:
With ActiveWorkbook.SlicerCaches("Slicer_test_id")
Dim i
For i = 1 To .SlicerItems.Count
.SlicerItems(i).Selected = stp.Exists(.SlicerItems(i).Caption)
Next i
End With
populating the Dictionary is super easy
Dim stp As New Dictionary
stp.Add "73148", "73148"
stp.Add "73150", "73150"
stp.Add "73159", "73159"
You need to reference the Microsoft Scripting Runtime
note that if you don't see Microsoft Scripting Runtime in the list you can Browse to C:\Windows\SysWOW64\scrrun.dll

Resources