Sub ReSort(L As Control)
Dim P%, PP%, C%, Pre$, S$, V&, NewPos%, CheckIt%

Dim TempL$, TempItemData&, S1$
For P = 0 To L.ListCount - 1
S = L.List(P)
For C = 1 To Len(S)
V = Val(Mid$(S, C))
If V > 0 Then Exit For
Next
If V > 0 Then
If C > 1 Then Pre = Left$(S, C - 1)
NewPos = -1
For PP = P + 1 To L.ListCount - 1
CheckIt = False
S1 = L.List(PP)
If Pre <> "" Then
If InStr(S1, Pre) = 1 Then CheckIt = True
Else
If Val(S1) > 0 Then CheckIt = True
End If
If CheckIt Then
If Val(Mid$(S1, C)) < V Then NewPos = PP
Else
Exit For
End If
Next
If NewPos > -1 Then
TempL = L.List(P)
TempItemData = L.ItemData(P)
L.RemoveItem (P)
L.AddItem TempL, NewPos
L.ItemData(L.NewIndex) = TempItemData
P = P - 1
End If
End If
Next
Exit Sub