Automatically Formatting Text within Quotes

In some programming language IDEs (e.g. Pycharm) one can select a word or phrase and press the single or double quote, or any type of bracket, which will enclose the selected text in quotes or brackets. Is it possible with Word?

As a copy editor, I ask all of you not to use quotes to make a word stand out. Use bold, italics, font color, or all caps instead. Quotes serve several specific purposes, and highlighting a word is not one of them.

How to add underlying to automatically formatting text within quotes?
Thanks.

I realized what I had done incorrectly in copying your macro into a "create" a macro and it worked. So now I use Alt I to run it and it works. Thanks. Took a few hours to figure out what I was doing incorrectly, but all is well.

To fix the macro so that it finds all occurrences of quote pairs add the line:
Selection.ExtendMode = False
just before the line:
blnSearchAgain = True

However, the macro will only find straight quotes. The following macro will find both straight and curley quote pairs. Beware, if there is a single quote in the document then it will upset the finding of pairs.

Sub BoldBetweenQuotes()
' quotes finding macro
Dim blnSearchAgain As Boolean
' move to start of doc
Selection.HomeKey unit:=wdStory
' start of loop
Do
With Selection.Find
.ClearFormatting
.Text = "[" & Chr(34) & "|" & Chr(147) & "]*[" & Chr(34) & "|" & Chr(148) & "]"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = True
.Execute
End With
If Selection.Find.Found Then
Selection.MoveStart unit:=wdCharacter, Count:=1
Selection.MoveEnd unit:=wdCharacter, Count:=-1
Selection.Font.Bold = True
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight unit:=wdCharacter, Count:=1
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain
End Sub

Hi: I tried to copy your macro you used for the bold text between quotes. I gave it a name, the record button came on I pasted your program macro to it and stopped recording. When I tried to run it, nothing happened. It actually gave me a copy of the macro I copied from your site. I used the Alt O as my keyboard shortcut. I tried copying your code using mouse and did not work, then I used Ctrl A to highlight whole code and paste in macro box and nothing happened. So I am doing something incorrectly. Any help please.

I tried the macro and it only bolds one word in the document.

Hello Alan,

I found your website through a search for my problem. Excellent website by the way!

The problem I am having is that I have a document with lots of text between quotes (signal names actually of varying word lengths) and I want to extract them to a separate document. A colleague of mine made a macro to extract acronyms to a new document, so I was thinking about a combination of this macro and the other.

I tried to combine the macros but can't get it to work. I tried your macro on a separate document, but it seems to make only the first quote bold. Is that correct?

Below my macro so far, any help is appreciated.

Best regards, Ferdinand Spek

Sub ExportBetweenQuotes()
Dim oDoc_Source As Document
Dim oDoc_Target As Document
Dim strListSep As String
Dim strQuote As String
Dim oTable As Table
Dim oRange As Range
Dim n As Long
Dim strAllFound As String

Set oDoc_Source = ActiveDocument
'Create new document for acronyms
Set oDoc_Target = Documents.Add
With oDoc_Target
'Make sure document is empty
.Range = ""
'Insert a table with room for acronym and definition
Set oTable = .Tables.Add(Range:=.Range, NumRows:=2, NumColumns:=2)
With oTable
'Format the table a bit
'Insert headings
.Cell(1, 1).Range.Text = "Quotation"
.Cell(1, 2).Range.Text = "Definition"
'Set row as heading row
.Rows(1).HeadingFormat = True
.Rows(1).Range.Font.Bold = True
.PreferredWidthType = wdPreferredWidthPercent
.Columns(1).PreferredWidth = 50
.Columns(2).PreferredWidth = 50
End With
End With
With oDoc_Source
' base for a quotes finding macro
Dim blnSearchAgain As Boolean
' move to start of doc
Selection.HomeKey Unit:=wdStory
' start of loop
Do
' set up find of first of quote pair
With Selection.Find
.ClearFormatting
.Text = Chr(34)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Execute
End With
If Selection.Find.Found Then
Selection.MoveRight Unit:=wdCharacter, Count:=1
' switch on selection extend mode
Selection.Extend
' find second quote of this pair
Selection.Find.Execute
If Selection.Find.Found Then
Selection.MoveLeft Unit:=wdCharacter, Count:=1
' make it bold
'Continue while found
strQuote = Selection.Text

'Insert in target doc
'If strQuote is already in strAllFound, do not add again
If InStr(1, strAllFound, "#" & strQuote & "#") = 0 Then
'Add new row in table from second acronym
If n > 1 Then oTable.Rows.Add
'Was not found before
strAllFound = strAllFound & strQuote & "#"
'Insert in column 1 in oTable
'Compensate for heading row
With oTable
'Insert acronym in column 1
.Cell(n + 1, 1).Range.Text = strQuote
'Insert definition in column 2
.Cell(n + 1, 2).Range.Text = "Temp"
End With
n = n + 1
End If

' Selection.Font.Bold = True
Selection.Collapse Direction:=wdCollapseEnd
Selection.MoveRight Unit:=wdCharacter, Count:=1
blnSearchAgain = True
Else
blnSearchAgain = False
End If
Else
blnSearchAgain = False
End If
Loop While blnSearchAgain
'Sort the acronyms alphabetically
With Selection
.Sort ExcludeHeader:=True, FieldNumber:="Column 1", SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderAscending
.HomeKey (wdStory)
End With
End With

'Clean up
Set oDoc_Source = Nothing
Set oDoc_Target = Nothing
Set oTable = Nothing
MsgBox "Finished extracting " & n - 1 & " quote(s) to a new document."
End Sub