Populate Word; rows w/values; columns w/named ranges same as bookmarks

[makeitwork09]

I am working on something where I want to take information from Excel (2007) and have it update Word (2007) where it is bookmarked. I have never done this before, but by using books and information online I have started the process.

Here is what have:
(1) The Excel worksheet has several hundred rows, which changes each month when the core macro is run (the one that extracts the data)
(2) There are several columns of data which will only change at this point if I am asked to add more columns

Here is where I am not what I should in terms of getting data to Word:
(1) Not every row and not every column needs to go to Excel. Only rows that have a value (not blank) in the column with the named range of delq_type need to go to Word.
(2) Most, but not all of the columns, all with named ranges, need to go to Word. In Word I have set up bookmarks, in a Word Template, with the same name as the named ranges.
(3) The Template layout is one page, but there can be more than one row with a value in the delq_type column. Being that I have not worked with Templates before, I am not sure if a new document needs to created for each row or something else needs to be done. I have yet to find an example of this.

Below is the snippet of code that I have, but it does not do what I need, because I do not know how to approach it.

Also, this code, as I round out is not working because the line that reads

wrdApp.ActiveDocument.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)

results in what is in the Refers To box of the Name Manager.

Here is the code I have thus far:

Sub UpdateWordDoc()

    Dim wrdApp As Word.Application
'    Dim xlWb As Excel.Workbook
    Dim xlName As Excel.Name
    Dim wrdDoc As Document
    
    On Error Resume Next
    
    BkName = ThisWorkbook.Name
    
    Set wrdApp = GetObject(, "Word.Application")
    If wrdApp Is Nothing Then
        Set wrdApp = GetObject("", "Word.Application")
        On Error GoTo ErrorHandler
        wrdApp.Documents.Add Template:="C:\SFPTemplate.dotx"
    End If
    
    On Error GoTo 0
    
    On Error GoTo ErrorHandler
    
    'Loop through names in the activeworkbook
    For Each xlName In Workbooks(BkName).Names
         'if xlName's name is existing in document then put the value in place of the bookmark
        If wrdApp.ActiveDocument.Bookmarks.Exists(xlName.Name) Then
'        wrdDoc.Bookmarks.Exists(xlName.Name) Then
            wrdApp.ActiveDocument.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
        End If
    Next xlName

    
     'Activate word and display document
    With wrdApp
        .Visible = True
        .ActiveWindow.WindowState = 0
        .Activate
    End With
     
     'Release the Word object to save memory and exit macro
ErrorExit:
    Set wrdApp = Nothing
    Exit Sub
     
     'Error Handling routine
ErrorHandler:
    If Err Then
        MsgBox "Error No: " & Err.Number & "; There is a problem"
        If Not wrdApp Is Nothing Then
            wrdApp.Quit False
        End If
        Resume ErrorExit
    End If
    
    
End Sub

Thanks

 

[makeitwork09]

I just had a thought. I am thinking that I should create a PivotTable to extract the rows and columns that I need, then take it from there.

Of course, I am not sure what the next from there is.

 

[SkipVought]

hi,

Why not embed a workbook in your doc or just link to an existing one. No VBA is really needed, unless you have to refresh the PT from your Word app, but that's just a few lines of code.

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[makeitwork09]

Skip,

I ended up taking your advice.

For the extracting the rows that I need, with the help of others, I did the following:

Sub BuildWorksheets()
'
' GetRecDetails Macro
'
    Dim TableName As String
    Dim DelTypeRange As Range
    Dim PoolRange As Range
    Dim LoanRange As Range
    Dim Cell As Range, cell2 As Range, cell3 As Range
    Dim r1 As Range
    Dim sh As Worksheet, sh2 As Worksheet
     
    Application.ScreenUpdating = False
    
    BkName = ThisWorkbook.Name
    
    'one sheet is created named with the combination of the values in Pool and loan for that row.


    Set DelTypeRange = ThisWorkbook.Names("delq_type").RefersToRange.EntireColumn
    Set r1 = DelTypeRange.SpecialCells(xlConstants)
    Set PoolRange = ThisWorkbook.Names("pool").RefersToRange.EntireColumn
    Set LoanRange = ThisWorkbook.Names("loan").RefersToRange.EntireColumn
    
    If r1 Is Nothing Then
        Exit Sub
    End If
    
    Workbooks(BkName).Worksheets("SFP Data Dump").Activate
    
    Set sh = Workbooks(BkName).Worksheets("Update SFP Data Dump")
    For Each Cell In r1
      Set cell2 = Intersect(Cell.EntireRow, PoolRange)
      Set cell3 = Intersect(Cell.EntireRow, LoanRange)
      
      If Not (cell2.Text = "pool" And cell3.Text = "loan") Then
        Worksheets.Add After:=Worksheets(Worksheets.Count)
        Set sh2 = ActiveSheet
        sh2.Name = cell2.Text & " " & cell3.Text
        Worksheets("Word Master").UsedRange.Copy sh2.Range("C2")
        Worksheets("Word Master").Cells.Copy
        Cells.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
'        Call UpdateWordDoc(sh2.Name)
        sh.Activate
    End If
    Next

    Application.ScreenUpdating = True

    
End Sub

To handle the word part I am attempting to do what I show in my latest post regarding error 91.


Thanks