Hallo,

leider verzweifel ich an einem Problem und meine Programmier- und googlekentnisse reichen anscheinend nicht aus.

Ich habe 3 Comboboxen welche verbunden miteinander arbeiten, den Code habe ich von einer Beispieldatei übernommen.

(http://www.herber.de/bbs/user/72401.xls)

In meinen anderen Comboboxen habe ich 2 Bedingungen welche ich auch hier implementieren möchte, aber es klappt nicht.

Ich habe die Bedingung das der erste Eintrag angezeigt wird, was bei allen Comboboxen der Fall sein soll (funktionierender Code):

If cboLOESUNG.ListCount > 0 Then
cboLOESUNG.ListIndex = 0
End If

Und die Funktion das nur weiße Zellen reingeladen werden soll nur bei der Ersten Combobox sein (Seriennummer)

If Zelle.Interior.ColorIndex <> 2 Then

cboLOESUNG.AddItem Zelle.Value

End if

Wie gesagt beides funktioniert in meinen selbst gebauten einfachen Comboboxcodes aber in dem komplexen nicht...

Code:

Private Sub UserForm_Initialize()
    Dim Zelle As Range
    Dim aRow As Long
    Dim hshA As Object
    Dim i As Long
    
        Set hshA = CreateObject("Scripting.Dictionary")
        With ThisWorkbook.Sheets("Fehlerliste")
            For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                hshA(.Cells(i, 1).Text) = 0
            Next
            Me.cboSERIENNUMMER.List = hshA.Keys
        End With
        
        Set hshA = Nothing
        
        
End Sub

______________________________________________________________

Private Sub cboSERIENNUMMER_Change()
    Dim hshB As Object
    Dim i As Long
    Dim Zelle As Range
    
    Set hshB = CreateObject("Scripting.Dictionary")
    Me.cboBESCHREIBUNG.Clear
    Me.cboLOESUNG.Clear
    With ThisWorkbook.Sheets("Fehlerliste")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 1) = Me.cboSERIENNUMMER Then
                hshB(.Cells(i, 7).Text) = 0
            End If
            cboLOESUNG.Clear
        Next
        Me.cboBESCHREIBUNG.List = hshB.Keys
    End With
    Set hshB = Nothing
End Sub

_________________________________________________________________-

Private Sub cboBESCHREIBUNG_Change()
    Dim hshC As Object
    Dim i As Long
    Dim Zelle As Range

Set hshC = CreateObject("Scripting.Dictionary")
    Me.cboLOESUNG.Clear
    
    With ThisWorkbook.Sheets("Fehlerliste")
        For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(i, 7) = Me.cboBESCHREIBUNG Then
                hshC(.Cells(i, 12).Text) = 0
            End If
        Next
        Me.cboLOESUNG.List = hshC.Keys
    End With
    
    Set hshC = Nothing
End Sub

Ich danke für Hilfe