Find Object to fix text lists and start of paragraphs

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!?

Code:

---


    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

---

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

Code:

---

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.

Code:

---

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

---

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])"

Quote:

---

Originally Posted by rruckus

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.

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