Suchen und Listbox füllen

Private Sub cmdSuchen_Click()
Dim lng As Long
Dim i As Integer
Application.ScreenUpdating = False
With frmEingabe
.ListBox1.Clear
Worksheets(1).Activate
i = 0
For lng = 11 To ActiveSheet.UsedRange.Rows.Count
If InStr(LCase(Cells(lng, 53).Value), LCase(.TextBox1.Value)) > 0 Then
.ListBox1.AddItem Cells(lng, 1).Text
.ListBox1.Column(0, i) = Cells(lng, 53).Text
.ListBox1.Column(1, i) = Cells(lng, 54).Text
.ListBox1.Column(2, i) = Cells(lng, 55).Text
.ListBox1.Column(3, i) = Cells(lng, 56).Text
.ListBox1.Column(4, i) = Cells(lng, 57).Text
.ListBox1.Column(5, i) = Cells(lng, 58).Text
.ListBox1.Column(6, i) = Cells(lng, 59).Text
.ListBox1.Column(7, i) = Cells(lng, 60).Text
.ListBox1.Column(8, i) = Cells(lng, 61).Text
.ListBox1.Column(9, i) = Cells(lng, 62).Text
.ListBox1.Column(10, i) = Cells(lng, 63).Text
.ListBox1.Column(11, i) = Cells(lng, 64).Text
.ListBox1.Column(12, i) = Cells(lng, 65).Text
.ListBox1.Column(13, i) = Cells(lng, 66).Text
.ListBox1.Column(14, i) = Cells(lng, 67).Text
.ListBox1.Column(15, i) = Cells(lng, 68).Text
.ListBox1.Column(16, i) = Cells(lng, 69).Row
i = i + 1
Else
End If
Next lng
End With
Application.ScreenUpdating = True
Dim zelle As Range
Dim sBegriff As Date
If IsDate(TextBox1) Then
sBegriff = CDate(TextBox1)
Else
MsgBox "Es muss für diese Suche immer ein Datum vorhanden sein!", _
vbInformation, "Hinweis"
End If
If sBegriff = 0 Then Exit Sub
Set zelle = Worksheets(1).Columns(53) _
.Find(sBegriff, LookAt:=xlWhole)
If zelle Is Nothing Then
MsgBox "Suchbegriff wurde nicht gefunden!"
End If
End Sub