Private Sub Test()
Dim zMsg As String
    Dim bTausch As Boolean '= damit, wenn alles richtig ist, die schleife 
    ' verlassen wird
    Dim zTausch1 As String '= Merkvariable
    Dim zTausch2 As String
    Dim lx As Long '= Variable
    Dim Abstand As Long '= Abstand zwischen den Vergleichsparametern
    Dim Userliste() As String
 
ReDim Userliste(3, 1)
Userliste(0, 0) = "Peter"
Userliste(0, 1) = "Sport"
Userliste(1, 0) = "Xaver"
Userliste(1, 1) = "Musik"
Userliste(2, 0) = "Sabine"
Userliste(2, 1) = "Musik"
Userliste(3, 0) = "Sep"
Userliste(3, 1) = "Sport"
 
    Abstand = UBound(Userliste, 1) / 25
 
    If Abstand < 1 Then
      Abstand = 2
    ElseIf Abstand < 10 Then
      Abstand = 4
    End If
 
    Do While Abstand >= 1
      Do
        bTausch = False
        For lx = LBound(Userliste, 1) To (UBound(Userliste, 1) - Abstand)
          ' Ist das ganze nicht gleich...
          If StrComp(Userliste(lx, 1), Userliste(lx + Abstand, 1), 1) = 1 Then
            zTausch1 = Userliste(lx, 1)
            zTausch2 = Userliste(lx, 0)
            Userliste(lx, 1) = Userliste(lx + Abstand, 1)
            Userliste(lx, 0) = Userliste(lx + Abstand, 0)
            Userliste(lx + Abstand, 1) = zTausch1
            Userliste(lx + Abstand, 0) = zTausch2
            bTausch = True
          ElseIf StrComp(Userliste(lx, 1), Userliste(lx + Abstand, 1), 1) = 0 _
            Then
            ' da muss dann der zweite Vergleich rein...
          End If
        Next
      Loop While bTausch = True
      Abstand = Abstand / 2
    Loop
 
    For lx = LBound(Userliste, 1) To (UBound(Userliste, 1))
        zMsg = zMsg & vbCrLf & Userliste(lx, 1) & " " & Userliste(lx, 0)
    Next
    MsgBox zMsg
  End Sub