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