Consulting

Results 1 to 5 of 5

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

  1. #1
    VBAX Regular
    Joined
    Dec 2019
    Posts
    14
    Location

    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.

  2. #2
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    VBAX Regular
    Joined
    Dec 2019
    Posts
    14
    Location
    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.

  4. #4
    We just love it when you move the goalposts

    The following will maintain the formatting.

    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
    Last edited by gmayor; 01-01-2020 at 07:20 AM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    VBAX Regular
    Joined
    Dec 2019
    Posts
    14
    Location
    Quote Originally Posted by gmayor View Post
    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 !!!!!!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •