I'm new at this and need assistance with shortening/streamlining the 2 pieces of code that is repeated three times each (this is a shortened version as these pieces of code is repeated many more times).
Sub CreateWordDocTest()
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim myStoryRange As Word.Range
Dim InsName, InsNumber, CurrentYear, Industry, AnalysisToolPath, AnalysisToolName, FileNameFragment2, TodaysDate, TemplatePath As String
If RADType = "Full" Then
TemplatePath = Sheets("Metadata").Range("D8").Value
NotificationWhenDone = "Full RAD done"
TodaysDate = Now() 'Variable called TodaysDate would now contain the current system date and time
Else
TemplatePath = Sheets("Metadata").Range("D6").Value
NotificationWhenDone = "Summary RAD done"
TodaysDate = Now()
End If
Set wApp = CreateObject("Word.Application")
wApp.Visible = True 'Creates an instance of Word an makes it visible
Set wDoc = wApp.Documents.Open(TemplatePath, False) 'Opens the chosen full or summary RAD template
With wDoc 'Use the With statement to not repeat wDoc many times
'Start at the beginning of the Word document
.Application.Selection.HomeKey Unit:=wdStory 'Moves the selection to the beginning of the current story
InsName = Sheets("Parameters").Range("D4").Value
InsNumber = Sheets("Parameters").Range("D5").Value
CurrentYear = Sheets("Parameters").Range("D6").Value
Industry = Sheets("Parameters").Range("D7").Value
AnalysisToolPath = Sheets("Metadata").Range("D2").Value
FileNameFragment2 = InsNumber & " - " & InsName & " " & CurrentYear & ".xlsm"
AnalysisToolName = AnalysisToolPath & FileNameFragment2
'Write insurer name
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<<InsurerName>>" 'Find the exact text in the Word document
.Replacement.Text = InsName 'Replace this text with the insurername as defined
.Wrap = wdFindContinue 'The find operation continues when the beginning or end of the search range is reached
.Execute Replace:=wdReplaceAll 'Finds all occurences and executes the replacement
End With
Next myStoryRange
.Application.Selection.EndOf 'Selects until the end of the document
'Write insurer class
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<<InsurerClass>>"
.Replacement.Text = Industry
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
.Application.Selection.EndOf
'Write financial year
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<<CurrentYear>>"
.Replacement.Text = CurrentYear
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
.Application.Selection.EndOf
'Write significant classes
For Each myStoryRange In ActiveDocument.StoryRanges
With myStoryRange.Find
.Text = "<<SignificantClasses>>"
.Replacement.Text = SignificantclassesTxt
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next myStoryRange
.Application.Selection.EndOf
'Write insurer number
.Application.Selection.Find.Text = "<<InsurerNumber>>"
.Application.Selection.Find.Execute
.Application.Selection = Sheets("Parameters").Range("D5").Value
.Application.Selection.EndOf
'Write analyst name
.Application.Selection.Find.Text = "<<AnalystName>>"
.Application.Selection.Find.Execute
.Application.Selection = UserFullName
.Application.Selection.EndOf
'Write RiBS Wording
.Application.Selection.Find.Text = "<<RiBSWording>>"
.Application.Selection.Find.Execute
.Application.Selection = SignificantclassesRiBSTxt
.Application.Selection.EndOf
End With
End Sub