Поиск и выделение в таблице по нескольким параметрам - VBA

Формулировка задачи:

Ночи доброй! возник следующий вопрос: есть таблица(размерность может быть как увеличена, так и уменьшена) можно ли вывести на экран менюшку в котороый можно будет задавать несколько параметров поиска? к примеру в таблице надо найти все ячейки в которых встречаются сразу все эти критерии( П, Г, 234, МЗН) кол-во параметров может варьироваться от 1го до ++ вбивать параметры нужно ручками в специальном окошке(менюшке), (и в любом порядке) нужные ячейки будут подсвечиваться цветом к примеру "vbGreen"

Решение задачи: «Поиск и выделение в таблице по нескольким параметрам»

textual
                            Листинг программы 
                        
 
                            
                        
Sub wrkWITHmyCriteries()
Dim mRng As Range, AllCells As Range, currCell As Range
Dim mArr(), currKey, mVAR, i&, j&
Dim dict As Object, SecDict As Object
    mArr = Array("aaa", "b#2c2", "345")
    Set dict = CreateObject("scripting.dictionary")
        dict.comparemode = 1
    Set SecDict = CreateObject("scripting.dictionary")
        SecDict.comparemode = 1
        For i = LBound(mArr) To UBound(mArr)
            dict.Add mArr(i), mArr(i)
        Next 'i
        For Each currKey In dict.Keys
            mVAR = dict.Item(currKey)
                If IsNumeric(mVAR) Then
                    mVAR = CDbl(dict.Item(currKey))
                End If
            With ActiveSheet
            Set mRng = .UsedRange
                For Each currCell In mRng
                    If currCell.Value = mVAR Then
                        If SecDict.exists(mVAR) Then
                            SecDict.Item(mVAR).Add currCell.Address
                                Else
                                    SecDict.Add mVAR, New Collection
                                    SecDict.Item(mVAR).Add _
                                                        currCell.Address
                        End If
                    End If
                Next ' currCell
            End With 'ActiveSheet
        For i = 1 To SecDict.Item(mVAR).count
            If AllCells Is Nothing Then
                Set AllCells = Range(SecDict.Item(mVAR)(i))
                i = 2
            End If
            Set AllCells = Union(AllCells, _
                        Range(SecDict.Item(mVAR)(i)))
        Next 'i
    Next ' currKey
    With AllCells
        .Interior.ColorIndex = 35
    End With
End Sub