Suche in Spalte A bis D per Userform1

Private Sub CommandButton1_Click()
suchenAbisD
End Sub

Private Sub UserForm_Initialize()
xA = Range("A65536").End(xlUp).Row: ListBox1.RowSource = "A5:A" & xA
xB = Range("B65536").End(xlUp).Row: ListBox2.RowSource = "B5:B" & xB
xC = Range("C65536").End(xlUp).Row: ListBox3.RowSource = "C5:C" & xC
xD = Range("D65536").End(xlUp).Row: ListBox4.RowSource = "D5:D" & xD
xE = Range("E65536").End(xlUp).Row: ListBox5.RowSource = "E5:E" & xE
End Sub

Private Sub TextBox1_Change()
Dim arr() As Variant
Dim index As Integer
xA = Range("A65536").End(xlUp).Row
If TextBox1.Value = "" Then
ListBox1.RowSource = "A5:A" & xA
Exit Sub
End If
ListBox1.RowSource = ""
ListBox1.Clear
For index = 5 To xA
If LCase(Left(Cells(index, 1), Len(TextBox1))) = LCase(TextBox1) Then
If Sheets("Tabelle1").Cells(index, 1) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 1)
iCount = iCount + 1
ListBox1.Column = arr
End If
End If
Next
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaNameA = ListBox1.Value
Unload Me
End Sub

Private Sub TextBox2_Change()
Dim arr() As Variant
Dim index As Integer
xB = Range("B65536").End(xlUp).Row
If TextBox2.Value = "" Then
ListBox2.RowSource = "B5:B" & xB
Exit Sub
End If
ListBox2.RowSource = ""
ListBox2.Clear
For index = 5 To xB
If LCase(Left(Cells(index, 2), Len(TextBox2))) = LCase(TextBox2) Then
If Sheets("Tabelle1").Cells(index, 2) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 2)
iCount = iCount + 1
ListBox2.Column = arr
End If
End If
Next
End Sub

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaNameB = ListBox2.Value
Unload Me
End Sub

Private Sub TextBox3_Change()
Dim arr() As Variant
Dim index As Integer
xC = Range("C65536").End(xlUp).Row
If TextBox3.Value = "" Then
ListBox3.RowSource = "C5:C" & xC
Exit Sub
End If
ListBox3.RowSource = ""
ListBox3.Clear
For index = 5 To xC
If LCase(Left(Cells(index, 3), Len(TextBox3))) = LCase(TextBox3) Then
If Sheets("Tabelle1").Cells(index, 3) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 3)
iCount = iCount + 1
ListBox3.Column = arr
End If
End If
Next
End Sub

Private Sub ListBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaNameC = ListBox3.Value
Unload Me
End Sub

Private Sub TextBox4_Change()
Dim arr() As Variant
Dim index As Integer
xD = Range("D65536").End(xlUp).Row
If TextBox4.Value = "" Then
ListBox4.RowSource = "D5:D" & xD
Exit Sub
End If
ListBox4.RowSource = ""
ListBox4.Clear
For index = 5 To xD
If LCase(Left(Cells(index, 4), Len(TextBox4))) = LCase(TextBox4) Then
If Sheets("Tabelle1").Cells(index, 4) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 4)
iCount = iCount + 1
ListBox4.Column = arr
End If
End If
Next
End Sub

Private Sub ListBox4_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaNameD = ListBox4.Value
Unload Me
End Sub

Private Sub TextBox5_Change()
Dim arr() As Variant
Dim index As Integer
xE = Range("E65536").End(xlUp).Row
If TextBox5.Value = "" Then
ListBox5.RowSource = "E5:E" & xE
Exit Sub
End If
ListBox5.RowSource = ""
ListBox5.Clear
For index = 5 To xE
If LCase(Left(Cells(index, 5), Len(TextBox5))) = LCase(TextBox5) Then
If Sheets("Tabelle1").Cells(index, 5) <> "" Then
On Error Resume Next
ReDim Preserve arr(0, 0 To iCount)
arr(0, iCount) = Cells(index, 5)
iCount = iCount + 1
ListBox5.Column = arr
End If
End If
Next
End Sub

Private Sub ListBox5_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
FaNameE = ListBox5.Value
Unload Me
End Sub