adding items to an array

that didn't solve it, here iss the rest of the code

part that populates the listbox

       'Creates Catalog List
            Set dic = CreateObject("Scripting.Dictionary")
            For Each r In Range(CatCol & "2", Range(CatCol & Rows.Count).End(xlUp))
                If r.Value <> "" Then
                    For Each e In Split(r.Value, ",")
                        dic(StrConv(Trim$(e), 3)) = Empty
                    Next
                End If
            Next
            Me.ListBox1.List = dic.keys

code that autofilters the rows

   'Get Listbox Data
        Dim i As Integer
        Dim j As Long
        
        Dim MyArray As Variant
    ReDim MyArray(0)
    
    For i = 0 To ListBox1.ListCount - 1
        If Me.ListBox1.Selected(i) Then
            MyArray(UBound(MyArray)) = UCase(Me.ListBox1.List(i))
            ReDim Preserve MyArray(UBound(MyArray) + 1)
        End If
    Next i
               
 'test variables
Dim msg As String
Dim cellv As String


    'Skips filtering if "All Items" are selected
        If ListSelect <> "All Items" And ListBox1.Visible <> False Then
        
    'Filters the sheet based on selection

        Set rng = Range(CatCol & "1:" & CatCol & LastRow)
       
        For j = 1 To LastRow
        
        
        cellv = UCase(Range(CatCol & j))
            
            For i = LBound(MyArray) To UBound(MyArray)
                If Not IsEmpty(MyArray(i)) Then
                    If InStr(UCase(Range(CatCol & j)), UCase(MyArray(i))) Then
                        If UCase(Range(CatCol & j)) <> UCase(MyArray(i)) Then
                            MyArray(UBound(MyArray)) = Range(CatCol & j)
                            ReDim Preserve MyArray(UBound(MyArray) + 1)
                        End If
                    End If
                End If
                
            Next i
        Next j
        
'test
msg = ""
For i = LBound(MyArray) To UBound(MyArray)
    msg = msg & MyArray(i) & vbNewLine
Next i
MsgBox "the values of my dynamic array are: " & vbNewLine & msg
MsgBox UBound(MyArray) - LBound(MyArray) + 1

        
        rng.AutoFilter Field:=1, Criteria1:=MyArray, Operator:=xlFilterValues, visibledropdown:=False
    Application.ScreenUpdating = True
        End If



Unload Me


End Sub