Remove the loop e.g.
Code:
Sub Format_Route()
'https://social.msdn.microsoft.com/Forums/en-US/d616f43f-a9c2-4e70-937b-c778ed229bb3/need-help-regarding-formatting-multiple-paragraphs-individually-in-word-using-vba?forum=isvvba
If Not Selection.Paragraphs.Count = 4 Then
MsgBox "Select the four paragraphs to be formatted"
Exit Sub
End If
With Selection.Paragraphs(1) 'ROAD NAME
.LeftIndent = CentimetersToPoints(0)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 4
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.KeepWithNext = True
With .Range.Font
.Name = "Times New Roman"
.Size = 12
.Bold = True
End With
End With
With Selection.Paragraphs(2) 'RESTRICTION
.LeftIndent = CentimetersToPoints(0.2)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.KeepWithNext = True
With .Range.Font
.Name = "Times New Roman"
.Size = 12
.Bold = True
End With
End With
With Selection.Paragraphs(3) 'STRUCTURE TYPE AND STRUCTURE NUMBER
.LeftIndent = CentimetersToPoints(1.27)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.KeepWithNext = True
With .Range.Font
.Name = "Times New Roman"
.Size = 12
.Bold = False
End With
End With
With Selection.Paragraphs(4) 'STRUCTURE LOCATION
.LeftIndent = CentimetersToPoints(1.27)
.SpaceBefore = 0
.SpaceBeforeAuto = False
.SpaceAfter = 0
.SpaceAfterAuto = False
.LineSpacingRule = wdLineSpaceSingle
.Alignment = wdAlignParagraphLeft
.KeepWithNext = False
With .Range.Font
.Name = "Times New Roman"
.Size = 12
.Bold = False
End With
End With
End Sub