Combining more than one line of the same item into one line

dopey · #9 02-24-2023, 10:56 AM

Hi Andrew, thanks again for your help. I have one last favour to ask.

Most things now work as I want, apart from if a line contains more than one word, e.g. if I have "Yellow Paper##", I want it to put down "2 x Yellow Paper". However, it puts down the following:
2 x Yellow
2 x Paper

The variable 'r' has the value "Yellow Paper", until it goes past this line in the code:

Code:

    Do While r.Find.Execute(FindText:="<*>", MatchWildcards:=True, Wrap:=wdFindStop) = True

As soon as I go past this point, 'r' changes to "Yellow". I've tried a lot of ways to fix it, but I cannot figure out what I'm doing wrong.

Here is the code I'm using:

Code:

Sub ArrangeList()
    Dim r As Range

    Set r = ActiveDocument.Range
    If (r.Characters.Last.Text = vbCr) Then r.End = r.End - 1
    SortList r
End Sub
Function SortList(r As Range)
    Dim sWrd As String
    Dim Found As Boolean
    Dim N As Integer, i As Integer, j As Integer, k As Integer, WordNum As Integer
    N = r.Words.Count
    ReDim Freq(N) As Integer
    ReDim Words(N) As String
    Dim temp As String

    i = 1
    WordNum = 0
    Do While r.Find.Execute(FindText:="<*>", MatchWildcards:=True, Wrap:=wdFindStop) = True
        Selection.Font.Bold = False
        If i = N Then Exit Do
            Found = False
            For j = 1 To WordNum
                If Words(j) = r.Text Then
                    Freq(j) = Freq(j) + 1
                    Found = True
                    Exit For
                End If
            Next j
        If Not Found Then
            WordNum = WordNum + 1
            Words(WordNum) = r.Text
            Freq(WordNum) = 1
        End If
        i = i + 1
    Loop

    Set r = ActiveDocument.Range

    r.Collapse wdCollapseStart
    r.Collapse wdCollapseEnd

    r.Font.Italic = True
    r.Collapse wdCollapseEnd
    
    r.InsertParagraphBefore
    r.Collapse wdCollapseEnd

    For j = 1 To WordNum
        r.InsertAfter Freq(j) & " x " & Words(j) & vbCr
        r.Font.Italic = True
    Next j
    r.InsertAfter vbCr
    r.InsertAfter vbFormFeed

End Function

Thanks again

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
1st line of 4-line poem centrally aligned; how to get lines 2-4 to start at same location on page	Swarup	Word	6	09-16-2022 11:07 AM
Making mail merge blank fill a line to highlight that line	rgm60527	Mail Merge	2	02-22-2022 11:13 AM
word erases line bottom in tight line spacing when new line is added	ozzzy	Word	2	01-21-2021 06:41 AM
Usability of space between final line of body text and footnote separator line	Swarup	Word	6	07-28-2018 12:51 PM
Combining IMAP inbox and sent item folders	kenelder	Outlook	1	07-17-2015 02:58 PM