Microsoft Office Forums - View Single Post - Find a word in doc1, search for it in dictionary doc2, copy the meaning from doc 2 to doc 1

macropod · 09-15-2014, 03:36 PM

Try:

Code:

Sub AddDefinitions()
Application.ScreenUpdating = False
Dim FRDoc As Document, FRList, j As Long, StrFnd As String, StrRep As String
 'Load the strings from the reference doc into a text string to be used as an array.
Set FRDoc = Documents.Open("Drive:\FilePath\Dictionary.doc")
FRList = FRDoc.Range.Text
FRDoc.Close False
Set FRDoc = Nothing
With ActiveDocument.Range
  .Font.ColorIndex = wdBlue
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = True
    .MatchCase = True
    .Format = False
    .Wrap = wdFindContinue
    .MatchWildcards = False
    'Process each word from the Check List. Tab-delimited strings are assumed, formatted as:
    'Term <Tab> Definition
    For j = 0 To UBound(Split(FRList, vbCr)) - 1
      .Text = "(" & Split(Split(FRList, vbCr)(j), vbTab)(0) & ")"
      .Replacement.Text = "^&-" & Split(Split(FRList, vbCr)(j), vbTab)(1)
      .Execute Replace:=wdReplaceAll
    Next
    .MatchWildcards = True
    .Format = True
    .Text = "\(*\)"
    .Replacement.Text = "^&"
    .Replacement.Font.ColorIndex = wdRed
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

Note that you'll need to replace 'Drive:\FilePath\Dictionary.doc' with your
actual filename & path.

The above code assumes your dictionary has each word separated from its definition by a TAB and that there's only one definition per paragraph. The dictionary document must not have any content that doesn't conform to this (i.e. no empty paragraphs, no paragraphs lacking tabs, no paragraphs with more than one entry). For speed, the macro first turns the whole document blue, does the definition additions, then turns the original bracketed words red again. Anything not originally bracketed with thus end up blue.