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