Word document doesn't close properly - excel

Question

Data dynamically populating from drop-down list correctly; however, how may I get the Word document to close properly in between each entry?
Problem:
The Word document doesn't close properly in between each new entry in the Excel dynamic drop-down list.
What is occurring:
The loop is executing over each hospital; however, Word isn't closing in between each new entity. Result is that all the addresses and tables are inserting without interruption.
What should occur:
Each hospital with it's own unique data in a new Word document (attached, the Excel sheet "Table" has a drop-down in call B2 that autopopulates the table 1 and the hospital's address; the Word document has bookmarks to insert this data).
In advance, thank you very much for your expertise. I have tried various commands to close the active document in Word (not shown) but then cannot get Word to open up again with the template. Realize there is likely a simple solution to incorporate into the existing code.
Regards,
Karen
Sub MMISPMT()
Worksheets("table").Activate
'Declare variables
Dim WordApp As Object
Dim WordDoc As Object
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range
ActiveWindow.View = xlNormalView
'Set variables
'Which cell has data validation
Set dvCell = Worksheets("Table").Range("B2") 'this is a drop-down box of entity name values that
populates address info and table 1 in Word document
'Determine where validation comes from
Set inputRange = Evaluate(dvCell.Validation.Formula1)
Set WordApp = New Word.Application ' based on the template ref'd in WordDoc
'Word template to be used
Set WordDoc = WordApp.Documents.Add(Template:="C:\<pathway>\letter.docx", NewTemplate:=False,
DocumentType:=0)
'Begin loop
Application.ScreenUpdating = False
For Each c In inputRange
dvCell = c.Value
MsgBox dvCell
Debug.Print dvCell
Dim table1 As Range
Dim HosName As Range
Dim address1 As Range
Dim city As Range
Dim zip As Range
'Declare variables
Set table1 = Range("a10:g15")
Set HosName = Range("b2")
Set address1 = Range("ad5")
Set city = Range("ad6")
Set zip = Range("ad7")
HosName.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("HosName").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText
address1.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("address1").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText
city.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("city").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText
zip.Select
Selection.Copy
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("zip").Select
Set objSelection = WordApp.Selection
objSelection.PasteSpecial DataType:=wdPasteText
table1.Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
WordApp.Visible = True
WordApp.ActiveDocument.Bookmarks("table1").Select
Set objSelection = WordApp.Selection
objSelection.Paste
'Generate the Word template per hospital with data
WordApp.ActiveDocument.SaveAs2 Filename:="C:\<pathway>\" & HosName & " " & Format((Year(Now() + 1)
Mod 100), "20##") & _
Format((Month(Now() + 1) Mod 100), "0#") & _
Format((Day(Now()) Mod 100), "0#") & "-report.docx", _
FileFormat:=wdFormatXMLDocument
Next c
Application.ScreenUpdating = True
End Sub

Answer 1

You need to open the template at the top of the loop, then save and close the document at the bottom of the loop.
Also you can tidy up your code by factoring the copy/paste into a separate method.
Sub MMISPMT()
Dim WordApp As Object
Dim WordDoc As Object
Dim dvCell As Range
Dim inputRange As Range
Dim c As Range, wsTable As Worksheet
Set wsTable = Worksheets("Table")
Set dvCell = Worksheets("Table").Range("B2")
Set inputRange = Evaluate(dvCell.Validation.Formula1)
Set WordApp = New Word.Application ' based on the template ref'd in WordDoc
For Each c In inputRange.Cells
Set WordDoc = WordApp.Documents.Add(Template:="C:\<pathway>\letter.docx", _
NewTemplate:=False, DocumentType:=0)
dvCell = c.Value
CopyToBookmark wsTable.Range("B2"), WordDoc, "HosName"
CopyToBookmark wsTable.Range("AD5"), WordDoc, "address1"
CopyToBookmark wsTable.Range("AD6"), WordDoc, "city"
CopyToBookmark wsTable.Range("AD7"), WordDoc, "zip"
CopyToBookmark wsTable.Range("A10:G15"), WordDoc, "table1", False
WordDoc.SaveAs2 Filename:="C:\<pathway>\" & HosName & " " & _
Format((Year(Now() + 1) Mod 100), "20##") & _
Format((Month(Now() + 1) Mod 100), "0#") & _
Format((Day(Now()) Mod 100), "0#") & "-report.docx", _
FileFormat:=wdFormatXMLDocument
WordDoc.Close
Next c
End Sub
'transfer/copy data from a Range into a named bookmark in doc
' either directly as text or copy/paste as table
Sub CopyToBookmark(rng As Range, doc As Word.document, bmk As String, _
Optional AsValue As Boolean = True)
If AsValue Then
doc.bookmarks(bmk).Range.Text = rng.Value
Else
rng.Copy
doc.bookmarks(bmk).Range.Paste
End If
End Sub