Thanks Macropod, I was able to adapt your code and incorporate it within the existing routine.
Full routine incase anybody finds this of benefit:
'
' Proof of concept code that will take all the named values in
' the worsheet ResultTalbes and insert them into the document
' defined at the top of the sheet with using the vlaues for
' Target Word File, and Target Word Doc.
'
'
Option Explicit
Sub InsertIntoWordBookmark()
' define error handler
On Error GoTo ErrorHandler
'
' resltValues is a collection of the names from the ResultTables
' worksheet
Dim resultValues As Collection
Set resultValues = New Collection
' resultValues is an excel name object as a member of the resultValues collection
Dim resultValue As Excel.Name
'
' declare and set the variable nms a the active workbooks
' names collection. The workbooks names collection contains
' all the workbook's named cell rangesthese will be used to
' insert the target word document.
Dim nms As Excel.Names
Set nms = ActiveWorkbook.Names
'
' loop incrementer
Dim i As Integer
'
' create the word target document, the document is set later it the script
Dim targetWord As Word.Document
'
' loop through excel named ranges and set the name of the bookmarks that
' will be updated are only from the worksheet named Result Tables
For i = 1 To nms.Count
'copy range value
' If nms(i).RefersToRange.Parent.Name = "ResultTables" Then
resultValues.Add Item:=nms(i), Key:=nms(i).Name
' End If
Next i
'
'
' create and set the word application object
Dim appWord As Word.Application
Set appWord = New Word.Application
' open word doc
Dim pathToWord As String
pathToWord = ThisWorkbook.Path & "\Doc1.docx"
Set targetWord = appWord.Documents.Add(pathToWord)
'
' loop through the word document and create a temporary collection
' of the documents original bookmarks, the script will delete any
' new bookmarks that are introduce by the insertion process.
Dim oBookmarks As Collection
Dim oBookmark As Word.Bookmark
Dim delete As Boolean
'
Set oBookmarks = New Collection
For Each oBookmark In targetWord.Bookmarks
oBookmarks.Add Item:=oBookmark, Key:=oBookmark.Name
Next oBookmark
'
' loop through our results and paste into word
For Each resultValue In resultValues
If targetWord.Bookmarks.Exists(resultValue.Name) Then
' determine if the source area in Excel is a single cell range, or a
' multiple cell range.
If resultValue.RefersToRange.Count > 1 Then
' we have a table
InsertTable targetWord, resultValue
ElseIf resultValue.RefersToRange.Count = 1 Then
' we have a value
InsertValue targetWord, resultValue
End If
End If
Next resultValue
'Copy charts to bookmarks
InsertChart targetWord
'
' clean up any introduced bookmarks
Dim targetBookmark As Word.Bookmark
For Each targetBookmark In targetWord.Bookmarks
delete = True
For Each oBookmark In oBookmarks
If UCase(oBookmark.Name) = UCase(targetBookmark.Name) Then
delete = False
' found a match break out of loop
Exit For
End If
Next oBookmark
' delete bad bookmark
If delete Then
targetBookmark.delete
End If
Next targetBookmark
'
' activate word document
With appWord
.Visible = True
.ActiveWindow.WindowState = 1
.Activate
End With
ErrorExit:
Set appWord = Nothing
Set targetWord = Nothing
Exit Sub
'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & ". " & Err.Description
If Not appWord Is Nothing Then
appWord.Quit False
End If
Resume ErrorExit
End If
End Sub
' inserts a single cell range excel value into a word document "targetWord" at
' the insertion point bookmarkName
Sub InsertValue(targetWord As Word.Document, bookmarkName As Excel.Name)
Dim myRange As Word.Range
'
' check that the bookmark exists in both excel and word
If targetWord.Bookmarks.Exists(bookmarkName.Name) Then
'
' activate the word doucment, got and update the current bookmark
Set myRange = targetWord.Bookmarks(bookmarkName.Name).Range
'
' redefine the text value of the range
myRange.Text = bookmarkName.RefersToRange.Text
'
' redefine the bookmark because it is destroyed when the value
' is changed.
myRange.Bookmarks.Add Name:=bookmarkName.Name
End If
End Sub
' pastes a range of excel values into a word document "targetWord" at
' the insertion point bookmarkName
Sub InsertTable(targetWord As Word.Document, bookmarkName As Excel.Name)
'
' this is the range of the insertion point in the target document
Dim myRange As Word.Range
Dim newRange As Word.Range
'
' check that the bookmark exists in both excel and word
If targetWord.Bookmarks.Exists(bookmarkName.Name) Then
'
' set target range, cordinates of the insertion point in the word document
Set myRange = targetWord.Bookmarks(bookmarkName.Name).Range
'
' check if we are in a table
If myRange.Information(wdWithInTable) Then
' if so, delete the table
myRange.Tables(1).delete
End If
'
' copy the result table from xl
Range(bookmarkName.Name).Copy
'
' collapse range so our insertions don't overlap with ranges
myRange.Collapse Direction:=wdCollapseStart
'
' The myRangeStart variable is used to store the static location of the start
' position of the myRange. When the paste method is executed the start position
' changes and the original is needed to reset the bookmark.
Set newRange = targetWord.Range(myRange.Start, myRange.Start)
'
' paste table
myRange.PasteSpecial Link:=False, DataType:=wdPasteHTML
myRange.Tables(1).AutoFitBehavior (wdAutoFitWindow)
'
' reset target bookmark
targetWord.Bookmarks.Add Name:=bookmarkName.Name, Range:=newRange
End If
Application.CutCopyMode = False
End Sub
' pastes a chart from excel into a word document "targetWord" at
' the insertion point bookmarkName
Sub InsertChart(targetWord As Word.Document)
Dim wdDoc As Word.Document, xlShp As Excel.Shape
Set wdDoc = targetWord
With wdDoc
For Each xlShp In ActiveWorkbook.ActiveSheet.Shapes
If .Bookmarks.Exists(xlShp.Name) Then
xlShp.Copy
.Bookmarks(xlShp.Name).Range.Paste
End If
Next
End With
Set wdDoc = Nothing
End Sub