Sub SortIgnoringSpaces()
' Paul Beverley - Version 27.02.26
' Copies the selected list but sorted letter by letter

Dim para As Paragraph
Dim tmp As String
Dim i As Long
Dim arr() As String
Dim keyArr() As String
Dim n As Long

If Selection.Range.Paragraphs.Count < 3 Then
  Beep
  myResponse = MsgBox("Please select the list items to be sorted.", _
       vbInformation, "SortIgnoringSpaces")
  Exit Sub
End If

' Collect all paragraph texts
Set rng = Selection.Range.Duplicate

n = rng.Paragraphs.Count
ReDim arr(1 To n)
ReDim keyArr(1 To n)

For i = 1 To n
  tmp = Trim(rng.Paragraphs(i).Range.Text)
  tmp = Replace(tmp, Chr(13), "") ' remove end of paragraph mark
  arr(i) = tmp
  keyArr(i) = Replace(tmp, " ", "") ' remove spaces for sorting key
Next i

' Sort arrays using the key array
Dim j As Long, k As Long
Dim keyTmp As String, valTmp As String

For j = 1 To n - 1
  For k = j + 1 To n
    If StrComp(keyArr(j), keyArr(k), vbTextCompare) > 0 Then
      keyTmp = keyArr(j)
      keyArr(j) = keyArr(k)
      keyArr(k) = keyTmp
      
      valTmp = arr(j)
      arr(j) = arr(k)
      arr(k) = valTmp
    End If
  Next k
Next j

' Write sorted lines back into the document
rng.Collapse wdCollapseEnd
rng.InsertParagraphAfter
myStart = rng.Start
For i = 1 To n
  rng.InsertAfter arr(i) & vbCr
Next i
rng.Start = myStart
rng.Select
Beep
myTime = Timer
Do
Loop Until Timer > myTime + 0.2
Beep
End Sub