Sub ReverseBold()
Application.ScreenUpdating = False
Dim Rng As Range, bBld As Boolean
Set Rng = Selection.Characters.First
With Rng
  bBld = .Font.Bold
  Do While .End < Selection.End
    Do While .Characters.Last.Next.Font.Bold = bBld
      If .End < Selection.End Then
        .End = .End + 1
      Else
        Exit Do
      End If
    Loop
    .Font.Bold = Not bBld
    bBld = Not bBld
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub