Reverse Paragraph List Macro

[Sark]

Hi all.

I found the macro below to reverses the order of a text (paragraph) list. This works just fine, but affects the entire document.


How could I change this to apply the effect to just selected lines.

I've created a few macros in the past for an old version of CorelDraw I used to use, but the various syntex I've tried don't work with Word. Any advice would be appreciated.

Mark

Sub ReverseOrderOfParagraphs()
    Dim tmpTable As Table
    Dim rg As Range
   
    Set tmpTable = ActiveDocument.Range.ConvertToTable(Separator:=wdSeparateByParagraphs)
    With tmpTable
        .Columns.Add BeforeColumn:=.Columns(1)
       
        Set rg = .Cell(1, 1).Range
        rg.End = rg.End - 1
        rg.Fields.Add Range:=rg, Type:=wdFieldSequence, Text:="a"
        rg.Cells(1).Range.Copy
       
        .Columns(1).Select
        Selection.Paste
        Selection.Fields.Update
       
        .Sort ExcludeHeader:=False, FieldNumber:=1, SortOrder:=wdSortOrderDescending
       
        .Columns(1).Delete
       
        .ConvertToText
    End With
End Sub

[Guessed]

What happens if you change
ActiveDocument.Range
to
Selection.Range

[Sark]

That was embarressingly simple.
CorelDraw uses ActiveSelectionRange. I tried a dozen variations of this without success. Thanks for the advice it's much appreciated.

For anyone who comes across this thread in the future, below is the ammended version. I've also included a message box warning when the user forgets to select any text.

Sub ReverseOrderOfParagraphs()
    Dim tmpTable As Table
    Dim rg As Range

    InSelection = False
    If Selection.Type = wdSelectionIP Then
        MsgBox "Nothing Selected"
   End
End If

    Set tmpTable = Selection.Range.ConvertToTable(Separator:=wdSeparateByParagraphs)
    With tmpTable
        .Columns.Add BeforeColumn:=.Columns(1)
       
        Set rg = .Cell(1, 1).Range
        rg.End = rg.End - 1
        rg.Fields.Add Range:=rg, Type:=wdFieldSequence, Text:="a"
        rg.Cells(1).Range.Copy
       
        .Columns(1).Select
        Selection.Paste
        Selection.Fields.Update
       
        .Sort ExcludeHeader:=False, FieldNumber:=1, SortOrder:=wdSortOrderDescending
        .Columns(1).Delete
        .ConvertToText

    End With
End Sub

[Guessed]

I think the message box at the start needs to be a bit more complex to deal with the likely selections: less than two paragraphs; includes a table

Sub ReverseOrderOfParagraphs()
  Dim tmpTable As Table, rg As Range
  
  If Selection.Range.Paragraphs.Count < 2 Then
    MsgBox "You must select more than one paragraph"
    Exit Sub
  ElseIf Selection.Range.Tables.Count > 0 Then
    MsgBox "This macro doesn't work with selections which are in tables"
    Exit Sub
  End If
  
  Set tmpTable = Selection.Range.ConvertToTable(Separator:=wdSeparateByParagraphs)
  With tmpTable
    .Columns.Add BeforeColumn:=.Columns(1)
    
    Set rg = .Cell(1, 1).Range
    rg.End = rg.End - 1
    rg.Fields.Add Range:=rg, Type:=wdFieldSequence, Text:="a"
    rg.Cells(1).Range.Copy
    
    .Columns(1).Select
    Selection.Paste
    Selection.Fields.Update
    
    .Sort ExcludeHeader:=False, FieldNumber:=1, SortOrder:=wdSortOrderDescending
    .Columns(1).Delete
    .ConvertToText
  End With
End Sub

[Sark]

Or we could tie it up completely by saying "You must select two or more consecutive paragraphs."

Sark