Populate Word Merge Fields from Excel Macro

jessebh2003

Board Regular
Joined
Feb 28, 2020
Messages
71
Office Version
  1. 365
Platform
  1. Windows
I'm writing an Excel macro that would open a Word template and replace the merge fields with data from a specific cell in Excel. I've been searching the internet for weeks and have been mostly unsuccessful. Pulling from what I could find, I came up with the below. However, this didn't populate the merge fields.

For context, the Excel data is exported from our tracking system and then a summary macros is ran. The below macro would run second. Can someone help me figure out how to find a merge field in the template and replace it with the data from Excel? I'm really struggling with this one. Thanks.


VBA Code:
    ' Starts a Word document
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add(Template:="SomeWordTemplate.dotx", _
    NewTemplate:=False, DocumentType:=0)
    
    With wrdDoc
        .Application.Selection.Find.Text = "<<MergeFieldName1>>"
        .Application.Selection.Find.Execute
        .Application.Selection = Range("B5")
        
        .Application.Selection.Find.Text = "<<MergeFieldName2>>"
        .Application.Selection.Find.Execute
        .Application.Selection = Range("C5")
        

        .SaveAs2 Filename:=("NewFileName"), _
        FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=True
        
    End With
    
End Sub
 

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
This deletes the MergeField and substitutes the text from the cell in its place.

VBA Code:
Sub Macro1()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Add(Template:="SomeWordTemplate.dotx", _
    NewTemplate:=False, DocumentType:=0)
    
    Dim Fld As Word.Field
    
    With wrdDoc
        Set Fld = GetField(wrdDoc, "MergeFieldName1")
        If Not Fld Is Nothing Then
            Fld.Select
            .Application.Selection.Delete
            .Application.Selection.Text = Range("B5").Value
            .Application.Selection.Collapse wdCollapseEnd
        End If
        
        Set Fld = GetField(wrdDoc, "MergeFieldName2")
        If Not Fld Is Nothing Then
            Fld.Select
            .Application.Selection.Delete
            .Application.Selection.Text = Range("C5").Value
            .Application.Selection.Collapse wdCollapseEnd
        End If

        .SaveAs2 Filename:=("NewFileName"), _
        FileFormat:=wdFormatDocumentDefault, AddtoRecentFiles:=True
        
    End With
    
End Sub

Function GetField(WordDocument As Word.Document, FieldName As String) As Word.Field
    Dim FindField As Word.Field
    
    For Each FindField In WordDocument.Fields
        If InStr(1, FindField.Code, FieldName) > 0 Then
            Set GetField = FindField
            Exit Function
        End If
    Next
    Set GetField = Nothing
End Function
 
Upvote 0
Solution
That worked great! The value from the cell that's replacing the merge field is a function answer, so when the cell value is being placed into the word document the entire value is displaying.

My function is
Excel Formula:
=AVERAGE(Data!$B$3:$B$1000)
and is set to display two decimal places. In my test cell this equals 4.65. The value that is being pasted into the Word document is 4.64963503649635. Is there a way to past the displayed value (4.65) instead? Thanks!
 
Upvote 0
Use cell Text property rather than Value …​
 
Upvote 0
shknbk2,

Thanks so much for your help. I was able to get everything to work for me, but when another user imports the macro they are getting an error message. When first running the macro, the error "Compile error: User-defined type not defined" pops up for
VBA Code:
Function GetField(WordDocument As Word.Document, FieldName As String) As Word.Field
Then when we remove that line and try to run the macro, the same error message appears but this time for
VBA Code:
wrdApp As Word.Application

How can I get the macro to work for others and not just me? The entire code is below as well. Thanks.

VBA Code:
    Sub Create_ROL_Report()
    Dim wrdApp As Word.Application
    Dim wrdDoc As Word.Document
    Set wrdApp = CreateObject("Word.Application")
    wrdApp.Visible = True
    Set wrdDoc = wrdApp.Documents.Open("SomeTemplateName.dotx")
   
    Dim r As Word.Range
        Dim Fld As Word.Field
   
    With wrdDoc
        ' Populates Demographics text
        Set Fld = GetField(wrdDoc, "AttendanceCount")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "ActivityName")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("A1").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "ActivityDate")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J12").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        ' Populates Level 1 text
        Set Fld = GetField(wrdDoc, "AttendanceCount")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CompletedEvaluationsCount")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "EvaluationCompPercentage")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J7").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "OverallMeanScore")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J3").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
               
        Set Fld = GetField(wrdDoc, "OverallStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("K3").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        ' Populates Table 1 - Level 1 & 2
        Set Fld = GetField(wrdDoc, "RelevantMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "RelevantStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "NewInfoMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B14").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "NewInfoStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C14").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "IntendUseMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
               
        Set Fld = GetField(wrdDoc, "IntendUseStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       

        Set Fld = GetField(wrdDoc, "KnowledgeableMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B7").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "KnowledgeableStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C7").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "EffectiveMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B8").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "EffectiveStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C8").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "ResponsiveMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B9").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "ResponsiveStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C9").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "EnvironmentMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B10").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "EnvironmentStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C10").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "ActivityName2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("A1").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        ' Populates Table 2 - CME Questions
        Set Fld = GetField(wrdDoc, "OrganizedMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B18").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "OrganizedStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C18").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "BiasMean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B19").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "BiasStDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C19").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        ' Populates Table 3 - Objectives
        Set Fld = GetField(wrdDoc, "Obj1Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B23").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj1StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C23").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj2Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B24").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj2StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C24").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj3Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B25").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj3StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C25").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj4Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B26").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj4StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C26").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj5Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B27").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj5StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C27").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj6Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B28").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj6StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C28").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj7Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B29").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj7StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C29").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj8Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B30").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj8StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C30").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj9Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B31").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj9StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C31").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
       End If

        Set Fld = GetField(wrdDoc, "Obj10Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B32").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj10StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C32").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj11Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B33").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj11StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C33").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj12Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B34").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj12StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C34").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj13Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B35").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj13StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C35").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj14Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B36").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj14StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C36").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj15Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B37").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj15StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C37").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj16Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B38").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj16StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C38").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj17Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B39").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj17StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C39").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj18Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B40").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj18StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C40").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj19Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B41").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj19StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C41").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "Obj20Mean")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("B42").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "Obj20StDev")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("C42").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        ' Populates Learner Commentary
        Set Fld = GetField(wrdDoc, "LearningFormat1")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "LearningFormat1Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F5").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "LearningFormat2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "LearningFormat2Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "LearningFormat3")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E7").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "LearningFormat3Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F7").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        ' Populates Level 3 Text
        Set Fld = GetField(wrdDoc, "CommitChange1")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E22").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        ' Populates Level 3 Text
        Set Fld = GetField(wrdDoc, "CommitChange1Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F22").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "CommitAvgConf1")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("G22").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitChange2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E23").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "CommitChange2Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F23").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitAvgConf2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("G23").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "CommitChange3")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E24").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitChange3Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F24").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitAvgConf3")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("G24").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier1")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E37").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier1Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F37").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E38").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier2Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F38").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier3")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("E39").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitBarrier3Count")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("F39").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CompletedEvaluationsCount2")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J6").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If
       
        Set Fld = GetField(wrdDoc, "CommitChangeRespCount")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J9").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        Set Fld = GetField(wrdDoc, "CommitChangeCompPercentage")
        If Not Fld Is Nothing Then
            With .Application.Selection
                Fld.Select
                .Collapse wdCollapseStart
                .TypeText "."
                Fld.Select
                .Collapse wdCollapseEnd
                .TypeText "."
                Fld.Select
                .Delete
                Set r = .Application.Selection.Range
                r.Text = Range("J10").Text
                r.Select
                .Collapse wdCollapseStart
                .TypeBackspace
                r.Select
                .Collapse wdCollapseEnd
                .Delete
            End With
        End If

        ' Renames and saves the file to the Desktop
        .SaveAs2 Environ("userprofile") & "\Desktop\ROL Evaluation Report" & "_" & Sheets("Data").Range("B1").Value _
        & "_" & Format(Now, "yyyy-mm-dd hh-mm") & ".docx"
    End With
End Sub

Function GetField(WordDocument As Word.Document, FieldName As String) As Word.Field
    Dim FindField As Word.Field
   
    For Each FindField In WordDocument.Fields
        If InStr(1, FindField.Code, FieldName) > 0 Then
            Set GetField = FindField
            Exit Function
        End If
    Next
    Set GetField = Nothing
End Function
 
Upvote 0
On the other computer, open the Excel Visual Basic Editor (Alt + F11) and go to Tools -> References. Find and add (check) the Microsoft Word entry.
 
Upvote 0
On the other computer, open the Excel Visual Basic Editor (Alt + F11) and go to Tools -> References. Find and add (check) the Microsoft Word entry.
OH YEAH! Dang, I forgot that step. Thanks!!!
 
Upvote 0
I tried this script in a situation with the same mergefield used multiple times in a Word doc and it appears only the first mergefield was replaced. Is this designed to find and replace any instance of the mergefield or is this one and done?
 
Upvote 0
I tried this script in a situation with the same mergefield used multiple times in a Word doc and it appears only the first mergefield was replaced. Is this designed to find and replace any instance of the mergefield or is this one and done?
It’s a one and done and changes them out in order. My document has the same merge field a couple times and the macro replaces them in the order they appear in the Word document. It works well too! I have around 50 merge fields over three pages that are replaced in about 20 seconds.
 
Upvote 0

Forum statistics

Threads
1,213,535
Messages
6,114,194
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top