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

Singh_Edm · #1 09-13-2014, 08:45 PM

Hi

I have a 2000 page file that has sentences in the following format.

Tim is a nice boy. (Tim) (is) (a) (nice) (boy) (.)
Jane is a nice girl. (Jane) (is) (a) (nice) (girl) (.)

Most of the words inside the brackets () above have their meanings written in a different document, like a dictionary where the word is bold and the meaning is unbold. Everything is case sensitive. For e.g.

nice-kind, gentle

I want help with a macro please that searches the dictionary document for each word inside the parentheses in document 1 and then inserts the meaning next to it in blue color. For e.g. if I ran the macro, the result would be:

Tim is a nice boy. (Tim) (is) (a) (nice)-kind,gentle (boy) (.)
Jane is a nice girl. (Jane) (is) (a) (nice)-kind,gentle (girl) (.)

Thank you for your time.

macropod · #2 09-15-2014, 02:34 AM

How is your dictionary document laid out?

Singh_Edm · #3 09-15-2014, 02:47 AM

Thank you for your query. The dictionary document has words in bold followed by their meanings in unbold. For e.g.

school- a place for all round development of an individual
msofficeforums- an online platform where enthusiasts help solve each other's problems

New words don't always start from a new line but they are always bold. So the above two words might have occurred in the document as follows:

school- a place for all round development of an individual msofficeforums- an online platform where enthusiasts help solve each other's problems

macropod · #4 09-15-2014, 03:03 AM

Such a layout unnecessarily complicates processing. It certainly isn't how a dictionary would normally be laid out.

A dictionary would usually have one entry per line (paragraph) and something more that just bold/not-bold differentiating the words from their meanings (e.g. commas or tabs).

Singh_Edm · #5 09-15-2014, 03:10 AM

I understand. The word-meaning document is 314 pages so if an 'enter' is needed to separate one set of word & its meaning from the next word and its meaning, I can do that manually.

Also, if adding a certain symbol after every word ( before the meaning begins) helps, I can do that manually too.

So you can write a macro assuming those two are done.

macropod · #6 09-15-2014, 04:24 AM

That would certainly be workable with, say, the word, a tab between it and the definition, then a paragraph break before the next word.

gmaxey · #7 09-15-2014, 05:54 AM

Is someone paying you for creating\maintaining the 2000 page document and 360 page dictionary file or is it something you plan to sell as a completed work? I can't speak for Macropod, but your "so you can write a macro assuming those two are done." is a put off, because it leads me to believe that you assume other people will naturally write your code for free.

What have you tried?

Singh_Edm · #8 09-15-2014, 07:07 AM

I am a student and I volunteer for a small Canadian charity that tackles Drug Addiction among youth in Canada. This is part of a project of translating ancient scriptures and then distributing them among the youth. It is a new 2014 charity so we don't have the resources to get this done paid. I'm not a programmer but I know that macros make life lot easier.

macropod · #9 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.

Singh_Edm · #10 09-15-2014, 08:32 PM

Thank you for the effort you put in.

I couldn't write that ever. So I made dummy files with just 2-3 entries to execute the code and it was partially successful.

It gave an runtime error of subscript being outside range, I pressed 'end' and then it copied two meanings into the file but left the last one out. The green and red colors were also lost. I've attached the files here. Files have just 2-3 sentences.

If you can let me know why it didn't work or if you can send the dummy files you might have used to test the code, that'd be great. Many thanks! Truly.

macropod · #11 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 · #12 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?

macropod · #13 09-15-2014, 09:19 PM

It would be helpful if you didn't keep changing the colours around. Your first post had the green font for the un-bracketed text and the red font for the bracketed text, but your attachment has these reversed. You could change wdRed to wdGreen.

Singh_Edm · #14 09-15-2014, 10:49 PM

Oh that's my mistake Sorry. I'll figure it out now.
One last question. If you could write a few lines that press a 'tab' at the end of each word in bold, it will be great. I did it manually for 32 pages of the dictionary document but it took very very long.

macropod · #15 09-15-2014, 11:42 PM

You don't actually need a macro for that - you could do it using just Find/Replace. Takes just a few seconds that way. Simply set the Find to look for a bold font and, for the Replace expression, use:
^&^t

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