Code optimieren

Private Sub TextBox1_Change()
On Error Resume Next
Dim arr() As Variant, Tmp As Variant, wks As Worksheet, zelle, preis1 As Currency, preis2 As  _
Currency, preisg As Currency
Dim index As Integer
Dim X, anz, icount
anz = 0
zelle = Cells(12, 4)
Set wks = Sheets("Stamm")
X = wks.Range("C65536").End(xlUp).Row
Tmp = wks.Range("C4:CH" & 4 + X)
X = X - 4
If TextBox1 = "" Then
On Error GoTo weiter
ReDim arr(0 To 5, 0 To X - 1)
For index = 1 To UBound(Tmp, 1)
On Error Resume Next
arr(0, icount) = Tmp(index, 23)
arr(1, icount) = Tmp(index, 35)
arr(2, icount) = Tmp(index, 20)
preis1 = Tmp(index, 37)
preis2 = Tmp(index, 38)
preisg = preis1 + preis2
arr(3, icount) = VBA.Format(preisg, "0.00")
arr(4, icount) = Tmp(index, 2)
arr(5, icount) = Tmp(index, 1)
Next
weiter:
ListBox1.Clear
Länge.Enabled = True
Else
For index = 1 To UBound(Tmp, 1)
If VBA.LCase(Left(Tmp(index, 23), VBA.Len(TextBox1))) = VBA.LCase(TextBox1) _
Or Tmp(index, 23) Like "*" & VBA.UCase(TextBox1) & "*" _
Or Tmp(index, 23) Like "*" & VBA.LCase(TextBox1) & "*" _
Or VBA.LCase(Left(Tmp(index, 1), VBA.Len(TextBox1))) = VBA.LCase(TextBox1) _
Or Tmp(index, 1) Like "*" & VBA.UCase(TextBox1) & "*" _
Or Tmp(index, 1) Like "*" & VBA.LCase(TextBox1) & "*" _
Or VBA.LCase(Left(Tmp(index, 2), VBA.Len(TextBox1))) = VBA.LCase(TextBox1) _
Or Tmp(index, 2) Like "*" & VBA.UCase(TextBox1) & "*" _
Or Tmp(index, 2) Like "*" & VBA.LCase(TextBox1) & "*" Then
ReDim Preserve arr(0 To 5, 0 To icount)
arr(0, icount) = Tmp(index, 23)
arr(1, icount) = Tmp(index, 35)
arr(2, icount) = Tmp(index, 20)
preis1 = Tmp(index, 37)
preis2 = Tmp(index, 38)
preisg = preis1 + preis2
arr(3, icount) = VBA.Format(preisg, "0.00")
arr(4, icount) = Tmp(index, 2)
arr(5, icount) = Tmp(index, 1)
icount = icount + 1
anz = anz + 1
End If
Next
End If
werticount = icount
If icount  0 Then
ListBox1.Column = arr
Else
ListBox1.Clear
End If
End Sub