Поиск и выделение разных форматов одновременно

Sub Макрос2()
Dim a As Long
a = 1
For i = 1 To 3000
    Selection.Find.ClearFormatting
    Selection.Find.Text = " "
    Selection.Find.Execute
        Selection.MoveLeft Count:=2 'пробел+1 - проверка соседней левой буквы
        
        If Selection.Font.Bold = -1 Then
        Selection.MoveRight Count:=3 'буква + пробел + буква - идем на проверку соседней правой
        Else: Selection.MoveRight Count:=2: GoTo 1 ' продолжаем цикл, если не выполненно Условие1 (жирный, в данном случае)
        End If
  
               If Selection.Font.Underline = 1 Then
               Selection.MoveLeft Count:=1: Selection.TypeParagraph: a = a + 1 ' заменяем на абзац
               Else: Selection.MoveLeft Count:=1 ' если вообще ничего не найденно, выравнием курсор
               End If
1: Next i
        
  MsgBox a 'потом через поиск можно проверить количество абзацев
'1:
End Sub