Listbox suchen

Private Sub TextBox1_Change()
Dim arr() As Variant
Dim index As Integer
X = Sheets("Liste").Range("B3000").End(xlUp).Row
If TextBox1.Value = "" Then
ListBox1.RowSource = "A6:G" & X
Exit Sub
End If
ListBox1.RowSource = ""
ListBox1.Clear
For index = 6 To X
If LCase(Left(Cells(index, 2), Len(TextBox1))) = LCase(TextBox1) Then
If Sheets("Liste").Cells(index, 2) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 2)
iCount = iCount + 1
ListBox1.Column = arr
End If
End If
Next
End Sub