Add unique items in Listbox based on Combobox

Try with this, change sheet names

Private Sub ComboBox1_Click()
Dim c As Range, Variance As String
ListBox1.Clear
With Sheets("Blad1").Range("C:C")
    Set c = .Cells.Find(Me.ComboBox1, LookIn:=xlValues)
    If Not c Is Nothing Then
        Variance = c.Address
        Do
            If Application.CountIf(Sheets("blad1").Range("D1", "D" & c.Row), c.Offset(, 1)) = 1 Then
                ListBox1.AddItem c.Offset(0, 1)
            End If
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> Variance
    End If
End With
End Sub

Kind regards
Leo