Microsoft Office Forums - View Single Post - [Solved] Select everything not inside quotations

gmayor · 08-27-2020, 12:44 AM

The following should do the trick. Create a new document with a two column table (no header row). Put the words to find in the left column, their replacements in the right column. Save it in your My Documents folder as Changes.docx and close it. Then run the following macro on your COPY document. Th macro assumes that your document has straight quotes. If it has English smart quotes then replace

Code:

Chr(34) & "*" & Chr(34)

with

Code:

Chr(147) & "*" & Chr(148)

Code:

Sub ReplaceFromTable()
Dim oChanges As Document, oTarget As Document
Dim oTable As Table
Dim oldpart As Range, newpart As Range
Dim oRng As Range
Dim i As Long
    Set oTarget = ActiveDocument
    Set oRng = oTarget.Range
    With oRng.Find
        'find quoted text, assumes straight quotes are used
        Do While .Execute(findText:=Chr(34) & "*" & Chr(34), MatchWildcards:=True)
            oRng.HighlightColorIndex = wdTurquoise
            oRng.Collapse 0
        Loop
    End With

    'table document (changes.docx)from  My Documents folder
    Set oChanges = Documents.Open(Environ("USERPROFILE") & "\Documents\changes.docx")
    Set oTable = oChanges.Tables(1)
    For i = 1 To oTable.Rows.Count
        Set oRng = oTarget.Range
        Set oldpart = oTable.Cell(i, 1).Range
        oldpart.End = oldpart.End - 1
        Set newpart = oTable.Cell(i, 2).Range
        newpart.End = newpart.End - 1
        With oRng.Find
            Do While .Execute(findText:=oldpart)
                If Not oRng.HighlightColorIndex = wdTurquoise Then
                    oRng.FormattedText = newpart.FormattedText
                End If
                oRng.Collapse wdCollapseEnd
            Loop
        End With
    Next i
    oChanges.Close wdDoNotSaveChanges
    oTarget.Range.HighlightColorIndex = wdNoHighlight
lbl_Exit:
    Set oRng = Nothing
    Set oTarget = Nothing
    Set oChanges = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub