Laufzeitfehler bei List Index

Private Sub ComboBox1_Change()
With ComboBox1
TextBox1.Text = .List(.ListIndex, 0)
TextBox2.Text = .List(.ListIndex, 1)
TextBox3.Text = .List(.ListIndex, 2)
TextBox15.Text = .List(.ListIndex, 3)
TextBox14.Text = .List(.ListIndex, 4)
TextBox7.Text = .List(.ListIndex, 5)
TextBox4.Text = .List(.ListIndex, 6)
TextBox5.Text = .List(.ListIndex, 7)
TextBox8.Text = .List(.ListIndex, 8)
TextBox10.Text = .List(.ListIndex, 9)
TextBox17.Text = .List(.ListIndex, 10)
End With
End Sub
Private Sub UserForm_Initialize()
Dim objCell As Range
Dim strFirsAddress As String
Cells(1, 1).Sort _
Key1:=Cells(2, 20), Order1:=xlAscending, _
Key2:=Cells(2, 17), Order2:=xlAscending, _
key3:=Cells(2, 18), order3:=xlAscending, _
Header:=xlYes
Dim AnzahlGes As Integer
With Box1
.AddItem "1 - Grün"
.AddItem "2 - Gelb"
.AddItem "3 - Rot"
.AddItem "4 - Weiß"
End With
With Box2
.AddItem "Name1"
.AddItem "Name2"
.AddItem "Nicht Relevant"
End With
AnzahlLeer = AnzahlZeilen(Worksheets("Tabelle16"), "S:S")
AnzahlGes = AnzahlZeilen(Worksheets("Tabelle16"), "A:A")
AnzahlLeer = AnzahlGes - AnzahlLeer
Label17.Caption = "Arbeitsvorrat " & AnzahlLeer
Set mobjCollection = New Collection
With Worksheets("Tabelle16")
For Each objCell In .Range(.Cells(2, 19), .Cells(.Rows.Count, 19))
If Not IsEmpty(objCell.Value) And IsEmpty(objCell.Offset(0, 3)) Then
TextBox1.Text = objCell.Offset(0, -18).Value
TextBox2.Text = objCell.Offset(0, -17).Value
TextBox3.Text = objCell.Offset(0, 0).Value
TextBox15.Text = objCell.Offset(0, -12).Value
TextBox14.Text = objCell.Offset(0, 2).Value
TextBox7.Text = objCell.Offset(0, -4).Value
TextBox4.Text = objCell.Offset(0, -8).Value
TextBox5.Text = objCell.Offset(0, -1).Value
TextBox8.Text = objCell.Offset(0, -15).Value
TextBox10.Text = objCell.Offset(0, -16).Value
TextBox17.Text = objCell.Offset(0, 4).Value
Box1.Text = objCell.Offset(0, 1).Value
mlngRow = objCell.Row
Call mobjCollection.Add(Item:=mlngRow)
Exit For
End If
Next
End With
With ComboBox1
.ColumnCount = 25
.ColumnWidths = "80;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0;0" 'Soviel 0en wie abgefragte Spalten
End With
Set objCell = Worksheets("Tabelle16").Columns(20).Find(What:="4 - Weiß", After:=Worksheets("Tabelle16").Cells(Worksheets("Tabelle16").Rows.Count, 20), _
LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=True) 'hier auf Spalte 20 bezogen
If Not objCell Is Nothing Then 'hier auf Spalte 20 bezogen
strFirsAddress = objCell.Address
Do
With ComboBox1
.AddItem objCell.Offset(0, -19).Value
.List(.ListCount - 1, 1) = objCell.Offset(0, -18).Value
.List(.ListCount - 1, 2) = objCell.Offset(0, 0).Value
.List(.ListCount - 1, 3) = objCell.Offset(0, -13).Value
.List(.ListCount - 1, 4) = objCell.Offset(0, 1).Value
.List(.ListCount - 1, 5) = objCell.Offset(0, -5).Value
.List(.ListCount - 1, 6) = objCell.Offset(0, -9).Value
.List(.ListCount - 1, 7) = objCell.Offset(0, -2).Value
.List(.ListCount - 1, 8) = objCell.Offset(0, -16).Value
.List(.ListCount - 1, 9) = objCell.Offset(0, -17).Value
.List(.ListCount - 1, 10) = objCell.Offset(0, 3).Value
End With
Set objCell = Worksheets("Tabelle16").Columns(20).FindNext(After:=objCell)
Loop Until objCell.Address = strFirsAddress
Set objCell = Nothing
End If
End Sub