The following should work. Select the list then run the macro
Sub SortSelectedList()
Dim oColl As Collection
Dim oRng As Range
Dim i As Integer
Dim strText As String
Set oRng = Selection.Range
oRng.Text = Replace(oRng.Text, Chr(11), Chr(13))
Set oColl = New Collection
For i = 1 To oRng.Paragraphs.Count
If InStr(1, oRng.Paragraphs(i).Range.Text, Chr(58)) > 0 Then
oColl.Add oRng.Paragraphs(i).Range.Text
End If
Next i
Set oColl = SortCollection(oColl)
For i = 1 To oColl.Count
strText = strText & CStr(oColl(i))
Next i
oRng.Text = strText
With oRng.Find
Do While .Execute(findText:=ChrW(9679))
oRng.Font.ColorIndex = wdRed
Loop
End With
lbl_Exit:
Set oRng = Nothing
Set oColl = Nothing
Exit Sub
End Sub
Private Function SortCollection(colInput As Collection) As Collection
Dim iCounter As Integer
Dim iCounter2 As Integer
Dim temp As Variant
Set SortCollection = New Collection
For iCounter = 1 To colInput.Count - 1
For iCounter2 = iCounter + 1 To colInput.Count
If Replace(colInput(iCounter), ChrW(9679), "") > _
Replace(colInput(iCounter2), ChrW(9679), "") Then
temp = colInput(iCounter2)
colInput.Remove iCounter2
colInput.Add temp, temp, iCounter
End If
Next iCounter2
Next iCounter
Set SortCollection = colInput
End Function