Listview Items Subitems löschen Sortieru

Hallo Ihr lieben,

ich hoffe Ihr könnt mir helfen.

Folgende Situation, ich habe eine Userform, diese enthält eine Combobox und ein Listview-Element.

Soweit funktioniert auch alles, allerdings wollte ich gern das mir die Daten in dem Listview untereinander angezeigt werden also das er Items und Subitems, die nicht mit meinen Kriterien matchen, ignoriert.

Mein Code sieht folgerndermaßen aus:

Private Sub UserForm_Initialize()

    'Deklaration der Variablen
    Dim dict As Object
    Dim lastRow As Long
    Dim i As Long
    
    'Initialisierung des Dictionaries
    Set dict = CreateObject("Scripting.Dictionary")
    
    'Bestimmung der letzten Zeile in Spalte E
    lastRow = Worksheets("Tabelle1").Cells(Rows.count, "E").End(xlUp).Row
    
    'Schleife zum Füllen des Dictionaries mit eindeutigen Werten aus Spalte E
    For i = 2 To lastRow
        dict(Worksheets("Tabelle1").Cells(i, "E").Value) = 1
    Next i
    
    'Schleife zum Füllen der Combobox mit den Werten aus dem Dictionary
    For Each Key In dict.Keys
        Me.ComboBox1.AddItem Key
    Next Key
    
    'Füllen des Listview-Elements mit Daten aus Tabelle1
    Dim LastColumn As Long
    Dim FirstColumn As Long
    Dim col As Long
    
    LastColumn = Worksheets("Tabelle1").Cells(1, Columns.count).End(xlToLeft).Column
    FirstColumn = 6 'Startspalte in Tabelle1
    
    'Fügen der Spaltenüberschriften zum Listview hinzu
    ListView1.ListItems.Clear
    For col = FirstColumn To LastColumn
        ListView1.ColumnHeaders.Add , , Worksheets("Tabelle1").Cells(1, col).Value, 80
    Next col

    'Listview-Einstellungen
    ListView1.View = lvwReport
    ListView1.Gridlines = True
    
End Sub

Private Sub ComboBox1_Change()

'Deklaration der Variablen
Dim selectedValue As String 'Ausgewählter Wert in der Combobox
Dim i As Long 'Zählvariable für die Schleife
Dim j As Long 'Zählvariable für die Schleife
Dim lastRow As Long 'Letzte Zeile in Spalte E
Dim lastCol As Long 'Letzte Spalte in der Tabelle
Dim rng1 As Range 'Bereich zum Markieren der Zellen
Dim rng2 As Range 'Bereich zum Markieren der Zellen
Dim rngsum As Range

'Auslesen des ausgewählten Werts in der Combobox
selectedValue = ComboBox1.Value

'Bestimmung der letzten Zeile in Spalte E
lastRow = Sheets("Tabelle1").Cells(Rows.count, "E").End(xlUp).Row

'Bestimmung der letzten Spalte in der Tabelle
lastCol = Sheets("Tabelle1").Cells(1, Columns.count).End(xlToLeft).Column

'Leeren des Listview-Elements
ListView1.ListItems.Clear

'Schleife zum Durchlaufen der Tabelle und zum Hinzufügen von Zeilen zum Listview-Element
For i = 2 To lastRow 'Start bei Zeile 2, da Zeile 1 die Überschriften enthält
    If Sheets("Tabelle1").Cells(i, "E").Value = selectedValue Then 'Überprüfung, ob der Wert in Spalte E mit dem ausgewählten Wert übereinstimmt
        'Hinzufügen einer neuen Zeile zum Listview-Element
        With ListView1.ListItems.Add
            If Sheets("Tabelle1").Cells(i, "F").Value  3 Then
                .text = Sheets("Tabelle1").Cells(i, "C").Value 'Hinzufügen des Werts aus Spalte F zur ersten Spalte der neuen Zeile
                If rng1 Is Nothing Then
                    Set rng1 = Sheets("Tabelle1").Cells(i, "F")
                Else
                    Set rng1 = Union(rng1, Sheets("Tabelle1").Cells(i, "F"))
                End If
            End If
            For j = 7 To lastCol 'Start bei Spalte 7, da die Spalten 1-6 bereits belegt sind
                If Sheets("Tabelle1").Cells(i, j).Value  3 Then
                    .ListSubItems.Add text:=Sheets("Tabelle1").Cells(i, "C").Value 'Hinzufügen des Werts aus der aktuellen Spalte zur neuen Zeile
                    If rng2 Is Nothing Then
                        Set rng2 = Sheets("Tabelle1").Cells(i, j) 'Erste Zelle markieren
                    Else
                        Set rng2 = Union(rng2, Sheets("Tabelle1").Cells(i, j)) 'Bereich erweitern
                    End If
                Else
                    .ListSubItems.Add text:=""
                End If
            Next j
        End With
    End If
Next i

Set rngsum = Union(rng1, rng2)
'Markieren der Zellen, die den Kriterien entsprechen
If Not rngsum Is Nothing Then rngsum.Select

End Sub