Hallo Brezi,

so sollte es jetzt funktionieren.

Habe das jetzt nachgebaut. Ist immer blöd, wenn man nicht testen kann.

Private Sub UserForm_Initialize()
 Dim oCol As New Collection
 Dim Obj As Range
 Dim i As Integer
 
 TextBox1.Value = "TT.MM.JJJJ"
 TextBox2.Value = "TT.MM.JJJJ"
  
'Daten sortiert in Collection einfügen
 For Each Obj In ThisWorkbook.Worksheets("Vergabe nach VE").Range("E7:E400")
     CollectionAddItem oCol, Obj.Value  'Wert in Collection
 Next Obj
 ComboBox1.Clear
 For i = 1 To oCol.Count
     ComboBox1.AddItem oCol.Item(i)     'Collection in Combobox
 Next i

End Sub

Function CollectionAddItem(oCol As Collection, ByVal sItem As String, Optional iPos As Integer, Optional ByVal vKey As Variant) As Long
'Funktion fügt einen Eintrag sortiert in eine Collectionsammlung ein, Einträge können nicht mehrfach vorkommen
  Dim nStart As Long, nEnd As Long, nX As Long
     
  If Trim$(sItem) = "" Then Exit Function
  With oCol
    If iPos <> 0 Then
       .Add sItem, vKey, iPos
    ElseIf .Count < 1 Then
       .Add sItem, vKey                     'wenn Collection noch leer ist
'Neuen Eintrag mit 1. Eintrag vergleichen
    ElseIf .Item(1) > sItem Then
       .Add sItem, vKey, 1                  'an 1. Position einfügen
    ElseIf .Item(1) Like sItem _
        Or .Item(.Count) Like sItem Then
'jetzt mit letzten Eintrag vergleichen
    ElseIf .Item(.Count) < sItem Then
        .Add sItem, vKey                    'an letzter Position einfügen
    Else
'durch binäre Suche die korrekte Position ermitteln
        nStart = 1: nEnd = .Count
        Do
          nX = (nStart + nEnd) \ 2
          If nX = nStart Then Exit Do
'Vergleich
          If .Item(nX) = sItem Then Exit Function
          If .Item(nX) > sItem Then nEnd = nX
          If .Item(nX) < sItem Then nStart = nX
        Loop
        On Error Resume Next
        .Add sItem, vKey, , nX
    End If
  End With
End Function

viele Grüße

Karl-Heinz