Sort lines ignoring the 1st character when it's a red dot “ ● ”

To manage my todo-list on Word, I sometimes sort by alphabetical order a previously selected part of it (see below).

Unfortunately, since I often use a red dot at the beginning of the line to draw attention to certain tasks, it disturbs the sorting.
I would like to find a way to make the sorting process ignore the presence of a dot at the beginning of the line.

So far, all I could think of (because my VBA is very poor) is:
- cut "manually" each point, then paste it at the end of the line
(I say lines but they are actually paragraphs, separated by line breaks)
- select the text to be sorted and then sort it.
- cut "manually" each point, then paste it at the beginning of the line

But obviously this is a slow process when it involves dozens of lines.
So I'm looking for a way to do it with a macro, but it's beyond my capabilities in VBA, which are very limited.

Can someone please help me?

Thanks...and Happy New Year!


TODO-LIST BEFORE SORTING
MDP : task n°1
●EVC : task n°2
MDP : task n°4
APV : task n°6
●BAF : task n°2
EVC : task n°1
BAF : task n°1
●BEG : task n°3
APV : task n°1
BEG : task n°2

TODO-LIST AFTER SORTING
APV : task n°1
APV : task n°6
BAF : task n°1
●BAF : task n°2
BEG : task n°2
●BEG : task n°3
EVC : task n°1
●EVC : task n°2
MDP : task n°1
MDP : task n°4

Paragraphs have been sorted regardless to the presence of a red dot.

The following should work. Select the list then run the macro

Code:

---

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

---

Hi!
Thank you so much for your quick answer.
Yes, your macro works.
But there's one problem : it suppresses all formatting (font name and color, highlighting, etc...) which is an important feature of my todo-list.
Is there a way to fix this ?

Thanks.

We just love it when you move the goalposts :banghead:

The following will maintain the formatting.

Code:

---

Sub SortSelectedList()

Dim i As Long
Dim oTable As Table
Dim oCell As Range
Dim oRng As Range
    Application.ScreenUpdating = False
    Set oRng = Selection.Range
    With oRng.Find
        Do While .Execute(Chr(11))
            If oRng.InRange(Selection.Range) Then
                oRng.Text = Chr(13)
            End If
            oRng.Collapse 0
        Loop
    End With
    Selection.ConvertToTable _
            Separator:=wdSeparateByParagraphs, _
            NumColumns:=1, _
            NumRows:=10, AutoFitBehavior:=wdAutoFitFixed
    Selection.InsertColumns
    Set oTable = Selection.Tables(1)
    For i = 1 To oTable.Rows.Count
        If oTable.Rows(i).Cells(2).Range.Characters(1) = ChrW(9679) Then
            oTable.Rows(i).Cells(2).Range.Characters(1).Cut
            oTable.Rows(i).Cells(1).Range.Paste
        End If
    Next i
    oTable.AutoFitBehavior wdAutoFitContent
    oTable.Sort ExcludeHeader:=False, _
                FieldNumber:="Column 2", _
                SortFieldType:=wdSortFieldAlphanumeric, _
                SortOrder:=wdSortOrderAscending
    For i = 1 To oTable.Rows.Count
        If oTable.Rows(i).Cells(1).Range.Characters(1) = ChrW(9679) Then
            oTable.Rows(i).Cells(1).Range.Characters(1).Cut
            Set oCell = oTable.Rows(i).Cells(2).Range
            oCell.Collapse 1
            oCell.Paste
        End If
    Next i
    oTable.Columns(1).Delete
    oTable.ConvertToText Separator:=wdSeparateByParagraphs
    Application.ScreenUpdating = True
    Application.ScreenRefresh
lbl_Exit:
    Set oTable = Nothing
    Set oCell = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

---

Quote:

---

Originally Posted by gmayor

We just love it when you move the goalposts

---

I'm sorry – actually I didn't think this had to be mentionned.

Otherwise, your code work perfectly. You're a Jedi !

Thank you so much !!!!!!