Numbered List

Create a numbered list using SEQuence fields

This will apply numbering to a range of paragraphs.
Using Ranges is much faster than using Selections

Sub CreateNumberedList() 
Dim objRange As Range 
Dim objDummyRange As Range 
Dim objSelectedRange As Range 
Dim lCounter As Long 

Set objSelectedRange = Selection.Range 

For lCounter = 1 To objSelectedRange.Paragraphs.Count 

    Set objRange = objSelectedRange.Paragraphs(lCounter).Range 

     'check paragrah contains text
    If Len(objRange.Text) > 1 Then 

        'Deletes existing seq field if present 

       Set objRange = objSelectedRange.Paragraphs(lCounter).Range 

       If objRange.Characters(1).Fields.Count > 0 Then 
           If (objRange.Fields(1).Type = wdFieldSequence) Then 
               objRange.Fields(1).Delete 
               'deletes the dot and tab as well 
               objRange.End = objRange.Characters(2).End 
               objRange.Delete 
           End If 
       End If 

       'insert new sequence field 

       objRange.Collapse 

       'first create a dummy range object and move it to the right one, 
       'so that it will end up being located AFTER the field you're adding. 
       'This is necessary because when you add a field to a range, 
       'the range (unlike selection) ends up at the start of the field!!! 
       'this is one of the unfortunate "features" of ranges 

       Set objDummyRange = objRange.Duplicate 
       objDummyRange.Move Unit:=wdUnits.wdCharacter, Count:=1 

       objRange.Fields.Add Range:=objRange, _ 
                           Type:=wdFieldEmpty, _ 
                           Text:="SEQ numberedlist\r" & lCounter, _ 
                           PreserveFormatting:=True 

       Set objRange = objDummyRange.Duplicate 
       objRange.Move Unit:=wdUnits.wdCharacter, Count:=-1 

       'Set paragraph indents as desired for list 

       With objRange.ParagraphFormat 
           .LeftIndent = CentimetersToPoints(1.27) 
           .FirstLineIndent = CentimetersToPoints(-1.27) 
       End With 

       objRange.InsertAfter "." & vbTab 
    End If 
Next lCounter 

objSelectedRange.Select 
End Sub