Microsoft Office Forums - View Single Post - Combining more than one line of the same item into one line

Guessed · 02-22-2023, 07:56 PM

My code works fine with your sample doc so I'm not sure why you weren't getting it to work. Perhaps your intended doc wasn't the ActiveDocument when you were testing the code.

I added a couple of extra lines to sort the result and remove the empty paragraph that my code created.

Code:

Sub List()
  Dim oDoc As Document, oTarget As Document
  Dim oRng As Range, oPara As Range
  Dim str As String, arr() As String, i As Integer
  
  Set oDoc = ActiveDocument
  Set oRng = oDoc.Range
  With oRng.Find
    .Forward = True
    .Wrap = wdFindStop
    .MatchWildcards = False
    .Text = "#"
    Do While .Execute = True
      Set oPara = oRng.Paragraphs(1).Range
      Debug.Print oPara.Text
      arr = Split(oPara.Text, "#")
      For i = 1 To UBound(arr)
        str = str & arr(0) & vbCr
      Next i
      oRng.Start = oPara.End
    Loop
  End With
  If str <> "" Then
    Set oTarget = Documents.Add
    oTarget.Range.Text = str    'put list into new unsaved doc
    oTarget.Range.Sort ExcludeHeader:=False
    oTarget.Range.Paragraphs(1).Range.Delete
  End If
End Sub