View Single Post
 
Old 04-04-2015, 12:27 AM
gmayor's Avatar
gmayor gmayor is offline Windows 7 64bit Office 2010 32bit
Expert
 
Join Date: Aug 2014
Posts: 4,137
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Not inappropriate, just no-one got around to it

Based on your illustration, and assuming the list document is consistent in its formatting and all the numbers are prefixed 'US', the following macro should work for you.

Change the names and paths of the two documents to reflect what you have. If you don't want the formatting in the table to match the formatting in the list, then replace the two instances of 'formattedtext' with 'text'
http://www.gmayor.com/installing_macro.htm
Code:
Option Explicit

Sub UpdateTable()
Dim oSource As Document
Dim oTarget As Document
Dim oRng As Range
Dim strFind As String
    'Open the document with the table
    Set oTarget = Documents.Open("C:\Path\EN\Target.docx")
    'Open the document with the list
    Set oSource = Documents.Open("C:\Path\EN\Source.docx")
    Set oRng = oSource.Range
    With oRng.Find
        With oRng.Find
            Do While .Execute(FindText:="US[0-9]{5,}", _
                              MatchWildcards:=True)        'The number as shown in the list document
                strFind = Trim(Replace(oRng.Text, "US", ""))        'Remove the 'US' Prefix from the found number
                oRng.MoveEnd wdParagraph, 5        'Move the end of the range that encompasses the found text the end of the required text
                oRng.MoveStart wdParagraph, 1        'Move the start of the range to start of the paragraph after the paragraph with the found text
                FillTable oTarget, oRng, strFind        'Call the sub to fill the table with the text from the range
                oRng.Collapse 0
            Loop
        End With
    End With
lbl_Exit:
    Set oSource = Nothing
    Set oTarget = Nothing
    Set oRng = Nothing
    Exit Sub
End Sub

Private Sub FillTable(oDoc As Document, _
                      oRng As Range, _
                      strFind As String)
Dim oCell As Range
Dim oFind As Range
Dim iRow As Long
    Set oFind = oDoc.Range
    With oFind.Find
        Do While .Execute(FindText:=strFind)
            iRow = oFind.Information(wdEndOfRangeRowNumber)
            Set oCell = oDoc.Tables(1).Rows(iRow).Cells(5).Range
            oCell.End = oCell.End - 1
            oCell.FormattedText = oRng.FormattedText        'use this line to keep the formatting
            'oCell.Text = oRng.Text 'use this line if the formatting is not required
            Exit Do
        Loop
    End With
lbl_Exit:
    Set oCell = Nothing
    Set oFind = Nothing
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote