VBA Find Bold Text within Brackets and Add Quotes

[Shelley Lou]

I want to change the code below to automatically add bold quotes to the bold text within brackets. At the moment I have to select multiple text to add the quotes. Advice always appreciated.

Before


Before.JPG

After
After.JPG

Sub BoldTextWithinBrackets_AddQuotes()
'Select multiple bold definitions and apply bold quotes
Application.ScreenUpdating = False
If Selection.Type = wdSelectionIP Then
 'MsgBox Prompt:="You have not selected any text!"
 MsgBox "You have not selected any text!", vbExclamation, "Invalid selection"
 Exit Sub
End If
With Selection.Find
   .ClearFormatting
   .Replacement.ClearFormatting
   .Forward = False
   .Wrap = wdFindStop
   .Format = True
   .MatchWildcards = False
    With Selection.Find
        .text = ""
        .Font.Bold = True
        .Replacement.text = """^&"""
        .Execute Replace:=wdReplaceAll
    End With
    Application.ScreenUpdating = True
   End With
End Sub

[gmaxey]

Sub BoldTextWithinBrackets_AddQuotes()
Dim oRng As Range
Set oRng = ActiveDocument.Range
Application.ScreenUpdating = False
With oRng.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = False
.Wrap = wdFindStop
.Format = True
.MatchWildcards = False
.Font.Bold = True
.Replacement.Text = """^&"""
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub

[Shelley Lou]

Hi Greg, thank you so much for replying and supplying the code - unfortunately the code adds quotes to all bold text and I only want to add quotes if the bold text is within parenthesis (brackets) - not sure how to look for this in code.

[gmaxey]

Sub BoldTextWithinBrackets_AddQuotes()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = False
    .Font.Bold = True
    While .Execute
      oRng.Select
      If oRng.Characters.First.Previous = Chr(40) And oRng.Characters.Last.Next = Chr(41) Then
        oRng.InsertBefore Chr(34)
        oRng.Characters.First.Font.Bold = True
        oRng.InsertAfter Chr(34)
      End If
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

[Shelley Lou]

Hi Greg, have just run the code but a debug message came up on the If oRng.Characters.First.Previous = Chr(40) And oRng.Characters.Last.Next = Chr(41)Then line - not sure why.


Capture.JPG

[gmaxey]

That would happen it the first word in the document was bold and no open paren preceding it.

Sub BoldTextWithinBrackets_AddQuotes()
Dim oRng As Range
  Set oRng = ActiveDocument.Range
  Application.ScreenUpdating = False
  With oRng.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Wrap = wdFindStop
    .Format = True
    .MatchWildcards = False
    .Font.Bold = True
    While .Execute
      On Error GoTo Err_Handler
      If oRng.Characters.First.Previous = Chr(40) And oRng.Characters.Last.Next = Chr(41) Then
        oRng.InsertBefore Chr(34)
        oRng.Characters.First.Font.Bold = True
        oRng.InsertAfter Chr(34)
      End If
Err_Handler:
      oRng.Collapse wdCollapseEnd
    Wend
  End With
  Application.ScreenUpdating = True
lbl_Exit:
  Exit Sub
End Sub

[Shelley Lou]

Hi Greg, yes the first words were bold in the document, thank you so much for the updated code, works perfectly.