Find Object to fix text lists and start of paragraphs

[rruckus]

I'm trying to write a macro to convert text lists copied from .txt files into real lists in Word. For example, replace the text "1. My first list item" with a true numbered list style so that Word will handle the numbering, e.g. "1. "

The macro is almost working, but if my text contains the characters "1. " somewhere in the paragraph, it will replace it. I only want to replace the "1. " at the START of paragraphs. It also doesn't work if the number is greater than 1 digit, e.g. "29.". Does anyone know how to fix this code to work!?




With myRange.Find
'REPLACE THE PREFIX ONLY
.Text = "([1-9]. )(*[^13])"
'SET THE STYLE
.Replacement.Style = "My Numbered List Style"
'REPLACEMENT TEXT IS EVERYTHING AFTER THE PREFIX "- "
.Replacement.Text = "\2" '"\2" refers to the second grouping in the find text above
.MatchWildcards = True
.Execute Format:=True, Replace:=wdReplaceAll
End With

[macropod]

The following macro converts manual multi-level numbering to the corresponding Heading Styles.

Sub ApplyHeadings()
Dim Para As Paragraph, Rng As Range, iLvl As Long
With ActiveDocument.Range
For Each Para In .Paragraphs
Set Rng = Para.Range.Words.First
With Rng
If IsNumeric(.Text) Then
While .Characters.Last.Next.Text Like "[0-9. " & vbTab & "]"
.End = .End + 1
Wend
iLvl = UBound(Split(.Text, "."))
If IsNumeric(Split(.Text, ".")(UBound(Split(.Text, ".")))) Then iLvl = iLvl + 1
If iLvl < 10 Then
.Text = vbNullString
Para.Style = "Heading " & iLvl
End If
End If
End With
Next
End With
End Sub
Note: As coded, the above macro assumes the headings are linked to the numbering levels. To limit the number of heading levels to which the macro applies, change the '10' in 'If iLvl < 10 Then'.
If you want auto-numbering but the Heading Styles lack it, you can apply it via the following macro, which applies list-level numbering to all headings in a document. Headings are also indented (in 0.5cm increments) according to their level.

Sub ApplyMultiLevelHeadingNumbers()
Dim LT As ListTemplate, i As Long
Set LT = ActiveDocument.ListTemplates.Add(OutlineNumbered:=True)
For i = 1 To 9
With LT.ListLevels(i)
.NumberFormat = Choose(i, "%1", "%1.%2", "%1.%2.%3", "%1.%2.%3.%4", "%1.%2.%3.%4.%5", "%1.%2.%3.%4.%5.%6", "%1.%2.%3.%4.%5.%6.%7", "%1.%2.%3.%4.%5.%6.%7.%8", "%1.%2.%3.%4.%5.%6.%7.%8.%9")
.TrailingCharacter = wdTrailingTab
.NumberStyle = wdListNumberStyleArabic
.NumberPosition = CentimetersToPoints(0)
.Alignment = wdListLevelAlignLeft
.TextPosition = CentimetersToPoints(0.5 + i * 0.5)
.ResetOnHigher = True
.StartAt = 1
.LinkedStyle = "Heading " & i
End With
Next
End Sub

[rruckus]

Thanks but by documents are around 400+ pages so looping through paragraphs won't work. I'm thinking maybe I have to do two "finds" to get this to work. I found the solution to the second part of my problem however, just add {1,10} after the numbers:
.Text = "([1-9]{1,10}. )(*[^13])"

[macropod]

Thanks but by documents are around 400+ pages so looping through paragraphs won't work.
Says who? Granted, it may be slower than the Find/Replace, but it's also more thorough - it works with multi-level numbering, which your Find/Replace won't do.

[rruckus]

"Says" my user community. I don't have multi-level numbering in my documents, so that's not an issue.