Find a word in doc1, search for it in dictionary doc2, copy the meaning from doc 2 to doc 1

macropod · #1 09-15-2014, 08:54 PM

The subscript out of range messages is because your dictionary document has an empty paragraph. I did say it must not have such paragraphs...

The reason that (nice) wasn't updated is because the macro is using a case-sensitive Find (via .MatchCase = True). That's a safeguard against (Bill) and (bill) both being treated as boys' names. So, either you need to provide both upper and lower case definitions in your dictionary, or you can change:
.MatchCase = True
to:
.MatchCase = False
and risk some definitions being wrong.

Try the following code revision:

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
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .MatchWholeWord = True
    .MatchCase = True
    .Format = True
    .Wrap = wdFindContinue
    .MatchWildcards = False
    .Replacement.Font.ColorIndex = wdBlue
    '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
    .Text = "\(*\)"
    .Replacement.Text = "^&"
    .Replacement.Font.ColorIndex = wdRed
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

Singh_Edm · #2 09-15-2014, 09:13 PM

Yay! It works. The only thing left now is that the original green color should also be retained. Any way to do that please?

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Find what box in Find and replace limits the length of a search term	Hoxton118	Word VBA	7	06-10-2014 05:05 AM
Won't find in search	ep2002	Word	3	10-31-2012 05:24 PM
Macro that can find phrase and then find another and copy	jperez84	Word VBA	10	09-19-2012 04:48 PM
where we can find the meaning for all the marks that Word uses?	Jamal NUMAN	Word	2	06-26-2011 09:49 AM
Search Replace Copy	dblack7211	Word	0	05-05-2010 01:19 PM