VBA: If range equals any of the listbox selection - excel

Question

I have a macro (Courtesy of another questions i posted on here) which works perfectly. It searched through data and rearranged it to my needs. It also only outputted information that matched a criteria given (E.g. A cell equals the specified string).
However, now i have added a list box in where the user can select multiple criteria. But i am not sure how i can use VBA to search through the data and only output the data which matches ANY of the list box selections. As shown in the image, if the user selects CONACC and CONPEND, the code should search through the data and then output the values where the cell equals either CONACC or CONPEND.
Any ideas?
Userform Screenshot
'type to manage data we use from each row
Type dataRow
notif As Variant
variable As Variant
sht As Variant
zone As Variant
End Type
Sub DoPivot()
Const SEP As String = "<>"
Dim rngData As Range, data, r As Long
Dim colDict As Object, rowDict As Object, comboDict As Object
Dim rd As dataRow, rngOutput As Range, col As Long, rw As Long, k
Dim k2, arr, dictCounts As Object
Dim wsOut As Worksheet, num As Long
Dim DataWS, OutputtedWS As Worksheet
Dim WS As Worksheet
Dim DataWb, OutputtedWb As Workbook
Dim DataFileName, DataSheetName, DataSheetFilter As String
Set colDict = CreateObject("scripting.dictionary")
Set rowDict = CreateObject("scripting.dictionary")
Set comboDict = CreateObject("scripting.dictionary")
Set dictCounts = CreateObject("scripting.dictionary")
DataFileName = DataFilter.FileLocationTextbox.Value
DataSheetName = DataFilter.SheetNameTextBox.Value
Set OutputtedWb = ThisWorkbook
Set DataWb = Workbooks.Open(DataFileName)
Set DataWS = DataWb.Sheets(DataSheetName)
Set OutputtedWS = Sheets.Add(After:=Sheets(Sheets.Count))
Dim DataWsLastCol As Long, DataWsLastColLet As String
Dim DataWsLastRow As Long
DataWsLastCol = DataWS.Cells(1, DataWS.Columns.Count).End(xlToLeft).Column
DataWsLastColLet = Split(Cells(1, DataWsLastCol).Address, "$")(1)
DataWsLastRow = DataWS.Range("A:" & DataWsLastColLet).SpecialCells(xlCellTypeLastCell).Row
data = DataWS.Range("A2:" & DataWsLastColLet & DataWsLastRow).Value 'source data
Set rngOutput = OutputtedWS.Range("A1") 'top-left cell for output
Set wsOut = rngOutput.Parent
rngOutput.Resize(5000, 5000).ClearContents
rngOutput.Resize(1, 6).Value = Array("Sheet", "Zone", "Feature Code", "Feature Description", "-TEN OGV KH73126 tolerance", "-TEN OGV KH73126 tolerance")
OutputtedWS.Cells(2, 5) = "Nominal"
OutputtedWS.Cells(2, 6) = "Tolerance"
Set notif = DataWS.Rows("1:1").Find(What:="Notification", lookat:=xlWhole)
Set variable = DataWS.Rows("1:1").Find(What:="Extent Var.", lookat:=xlWhole)
Set sht = DataWS.Rows("1:1").Find(What:="Sheet", lookat:=xlWhole)
Set zone = DataWS.Rows("1:1").Find(What:="Zone", lookat:=xlWhole)
Set CodeGroup = DataWS.Rows("1:1").Find(What:="Code group", lookat:=xlWhole)
notifcol = notif.Column
variablecol = variable.Column
shtcol = sht.Column
zonecol = zone.Column
CodeGroupCol = CodeGroup.Column
col = rngOutput.Column + 6 'start for notification# headers
rw = rngOutput.Row + 2
'first pass - assess data variables
For r = 1 To UBound(data, 1)
If data(r, CodeGroupCol) = [[[[[[THIS IS WHERE THE SELECTION WOULD GO]]]]]] Then
rd = rowData(data, r, notifcol, variablecol, shtcol, zonecol)
k = Join(Array(rd.sht, rd.zone, rd.notif), SEP) 'tracking how many unique combinations of these
comboDict(k) = comboDict(k) + 1 'increment count
'manage column header positions for unique notification numbers
If Not colDict.exists(rd.notif) Then
colDict.Add rd.notif, col 'store the column
rngOutput.EntireRow.Cells(1, col).Value = rd.notif 'add the header
col = col + 1
End If
End If
Next r
'figure out # of rows for each sheet-Zone pair
For Each k In comboDict.keys
arr = Split(k, SEP)
k2 = Join(Array(arr(0), arr(1)), SEP) 'sheet<>zone
'is this more rows than any previous same k2 value?
dictCounts(k2) = Application.Max(dictCounts(k2), comboDict(k))
Next k
'create the row headers
For Each k In dictCounts.keys
num = dictCounts(k)
rowDict(k) = rw 'record start row for each sheet<>zone combo
wsOut.Cells(rw, rngOutput.Column).Resize(num, 2).Value = Split(k, SEP)
dictCounts(k) = 0 'reset so we can track while adding data
rowDict(k) = rw
rw = rw + num
Next k
'last pass - populate the data based on the dictionaries
For r = 1 To UBound(data, 1)
If data(r, CodeGroupCol) = [[[[[[THIS IS WHERE THE SELECTION WOULD GO]]]]]] Then
rd = rowData(data, r, notifcol, variablecol, shtcol, zonecol)
k = Join(Array(rd.sht, rd.zone, rd.notif), SEP) '3-field combo
k2 = Join(Array(rd.sht, rd.zone), SEP) 'row key
wsOut.Cells(rowDict(k2) + (dictCounts(k)), _
colDict(rd.notif)).Value = rd.variable
dictCounts(k) = dictCounts(k) + 1 'increment this unique combo
End If
Next r
End Sub
'populate a Type instance for a given row
Function rowData(data, r As Long, notficationcol, variablecol, sheetcol, zonecol) As dataRow
Dim rv As dataRow
rv.notif = IfEmpty(data(r, notficationcol))
rv.variable = IfEmpty(data(r, variablecol))
rv.sht = IfEmpty(data(r, sheetcol))
rv.zone = IfEmpty(data(r, zonecol))
rowData = rv
End Function
'substitute EMPTY for zero-length value
Function IfEmpty(v)
IfEmpty = IIf(Len(v) = 0, "EMPTY", v)
End Function

Answer 1

Add another dictionary
Dim i As Integer, dictFilter As Object
Set dictFilter = CreateObject("scripting.dictionary")
With DataFilter.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) = True Then
dictFilter.Add .List(i), 1
End If
Next
End With
If dictFilter.exists(data(r, CodeGroupCol)) Then
'
'
End If