vba - Automatic Excel Acronym finding, Definition and Classification Adding -

i have been working code found here having difficulty getting 1 more task me. have added column (3) excel document has "classification" of acronym & definition , want add newly created word doc in column 1, before acronym. have tried several different ways of moving provided code around results in error. appreciated. have included working code below. said, works want 1 more thing. thank you!

sub extractacronymstonewdocument()   dim odoc_source document dim odoc_target document dim strlistsep string dim stracronym string dim strdef string dim otable table dim orange range dim n long dim m long m = 0 dim strallfound string dim title string dim msg string dim objexcel object dim objwbk object dim rngsearch object dim rngfound object dim targetcellvalue string  ' message box title title = "extract acronyms new document"  ' set message box message msg = "this macro finds acronyms (consisting of 2 or more " & _ "uppercase letters, numbers or '/') , associated definitions. " & _ "then extracts words table @ current location have selected" & vbcr & vbcr & _ "warning - please make sure check table manually after!" & vbcr & vbcr & _ "do want continue?"  ' display message box if msgbox(msg, vbyesno + vbquestion, title) <> vbyes exit sub end if   ' stop screen updating application.screenupdating = false   'find list separator international settings 'may comma or semicolon depending on country strlistsep = application.international(wdlistseparator)  'start string used storing names of acronyms found strallfound = "#"  ' give active document variable set odoc_source = activedocument  'create variable excel , open definition workbook set objexcel = createobject("excel.application") set objwbk = objexcel.workbooks.open("c:\users\username\documents\test_definitions.xlsx") 'objexcel.visible = true objwbk.activate  'create new document temporarily store acronyms set odoc_target = documents.add  ' use target document odoc_target  'make sure document empty .range = ""  'insert info in header - change date format wish .pagesetup.topmargin = centimeterstopoints(3) .sections(1).headers(wdheaderfooterprimary).range.text = _     "acronyms extracted from: " & odoc_source.fullname & vbcr & _     "created by: " & application.username & vbcr & _     "creation date: " & format(date, "mmmm d, yyyy")  'adjust normal style , header style .styles(wdstylenormal)     .font.name = "arial"     .font.size = 10     .paragraphformat.leftindent = 0     .paragraphformat.spaceafter = 6 end  .styles(wdstyleheader)     .font.size = 8     .paragraphformat.spaceafter = 0 end  'insert table room acronym , definition set otable = .tables.add(range:=.range, numrows:=2, numcolumns:=4) otable     'format table bit     'insert headings     .range.style = wdstylenormal     .allowautofit = false     .cell(1, 1).range.text = "classification"     .cell(1, 2).range.text = "acronym"     .cell(1, 3).range.text = "definition"     .cell(1, 4).range.text = "page"      'set row heading row     .rows(1).headingformat = true     .rows(1).range.font.bold = true     .preferredwidthtype = wdpreferredwidthpercent     .columns(1).preferredwidth = 15     .columns(2).preferredwidth = 25     .columns(3).preferredwidth = 55     .columns(4).preferredwidth = 5  end end    odoc_source set orange = .range  n = 1 'used count below  ' within total range of source document orange.find     'use wildcard search find strings consisting of 3 or more uppercase letters     'set search conditions     'note: if want find acronyms e.g. 2 or more letters,     'change 3 2 in line below     .text = "<[a-z][a-z0-9/]{1" & strlistsep & "}>"     .forward = true     .wrap = wdfindstop     .format = false     .matchcase = true     .matchwildcards = true      'perform search     while .execute      'continue while found     stracronym = orange      'insert in target doc     'if stracronym in strallfound, not add again     if instr(2, strallfound, "#" & stracronym & "#") = 0          'add new row in table second acronym         if n > 1 otable.rows.add              'was not found before             strallfound = strallfound & stracronym & "#"              'insert in column 1 in otable             'compensate heading row              otable                 .cell(n + 1, 2).range.text = stracronym              'insert page number in column 4                 .cell(n + 1, 4).range.text = orange.information(wdactiveendpagenumber)                  ' find definition excel document                 objwbk.sheets("sheet1")                     ' find range of cells data in excel doc                     set rngsearch = .range(.range("a1"), .range("a" & .rows.count).end(-4162))                      ' search in found range                     set rngfound = rngsearch.find(what:=stracronym, after:=.range("a1"), lookat:=1)                      ' if nothing found count number of acronyms without definitions                     if rngfound nothing                         m = m + 1                          ' set cell variable in new table blank                         targetcellvalue = ""                      ' if definition found enter cell variable                     else                         targetcellvalue = .cells(rngfound.row, 2).value                      end if                 end                  ' enter cell varibale definition cell                 .cell(n + 1, 3).range.text = targetcellvalue             end               ' add 1 loop count             n = n + 1          end if     loop end end    'sort acronyms alphabetically - skip if 1 found if n > 2  selection     .sort excludeheader:=true, fieldnumber:="column 2", sortfieldtype _         :=wdsortfieldalphanumeric, sortorder:=wdsortorderascending      'go start of document     .homekey (wdstory)  end end if  ' update screen application.screenupdating = true   'if no acronyms found set message saying  if n = 1 msg = "no acronyms found."   ' set final messagebox message show number of acronyms found , did not have definitions else msg = "finished extracting " & n - 1 & " acronymn(s) new document. unable find definitions " & m & " acronyms." end if  ' show finished message box on error resume next appactivate application.caption on error goto 0 msgbox msg, vbokonly, title  'close excel after objwbk.close saved = true  'clean set orange = nothing set odoc_source = nothing set odoc_target = nothing set otable = nothing set objexcel = nothing set objwbk = nothing    end sub 

if looking solution, able figure out duplicating following lines. counts how many definitions , classifications unable find , reports @ end.

               ' find definition excel document                 objwbk.sheets("sheet1")                     ' find range of cells data in excel doc                     set rngsearch = .range(.range("a1"), .range("a" & .rows.count).end(-4162))                      ' search in found range                     set rngfound = rngsearch.find(what:=stracronym, after:=.range("a1"), lookat:=1)                      ' if nothing found count number of acronyms without definitions                     if rngfound nothing                         m = m + 1                          ' set cell variable in new table blank                         targetcellvalue = ""                      ' if definition found enter cell variable                     else                         targetcellvalue = .cells(rngfound.row, 2).value                      end if                 end                  ' enter cell varibale definition cell                 .cell(n + 1, 3).range.text = targetcellvalue             end