Find and replace placeholders in Word with values from Excel

Question

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

Answer 1

To streamline this and remove the abundant code duplication, you could extract the two distinct parts you repeat into Subs taking parameters and then call those.

Private Sub ReplacePlaceholderInDocument(document As Word.Document, placeholder As String, replacement As String)

You could also get all placeholder values in another function and put them as key value pairs into a Scripting.Dictionary and call your new sub in a loop over the the dictionary keys.

There are a few more things that could be improved to enhance the maintainability of the code:

The code would really benefit from a better separation of concern. According to the single responsibility principle, each unit of program should be concerned with only one responsibility. Your sub seems to combine the responsibilities of choosing the template, getting the template, getting the replacement values (including getting the reference sheet and its name) and replacing the values. Each of these could go into its own sub or function after which the main sub only coordinates the use of the new subs and functions.

Next, I see that you are referring to the ActiveDocument, which is a bad idea most of the time. This will be different depending on which Word document currently has focus. It is usually better to use an explicit document, unless the currently active document is really what you need.

You also take values from the reference sheets from explicit cell addresses. That is rather fragile: any layout change can make the code invalid. A better alternative is to use named ranges in Excel. These can be referred to using their name.

You also seem to take values from variables defined outside the sub, like UserFullName. Unless this is a method to be called as a makro, you might consider to make these parameters of the sub. That would make the sub more self contained.

Finally, it is a good practice to state accessibilities exicitly. The sub is currently defined without one, which means that it is implicitly Public.

There are probably a few more improvements one could make, but I will leave it with this.

Answer 2

You aren't giving a Type to most of these variables -

Dim InsName, InsNumber, CurrentYear, Industry, AnalysisToolPath, AnalysisToolName, FileNameFragment2, TodaysDate, TemplatePath As String

In fact, only TemplatePath has a type. The rest are all variants. You need to explicitly type all of them e.g.

Dim InsName as String, InsNumber as String, CurrentYear as String, ...

When you don't define your variable, VBA will declare it as a Variant type that can hold any type of data. While this may be more flexible, it adds processing time to your macro as VBA decides or tests for the type. Additionally, since a Variant can be any type of data, you may miss out on valuable troubleshooting information on Type Mismatch

When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

This also includes not defining RADType, NotificationWhenDone etc

---

You have a bunch of comments. Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

---

Dim wApp As Word.Application
Set wApp = CreateObject("Word.Application")

Are you using early binding or late binding, because you're doing both. Either

Dim wApp As Object
Set wApp = CreateObject("Word.Application")

or

Dim wApp As Word.Application
Set wApp = New Word.Application

---

As you know, When you repeat code you can most likely benefit from refactoring it. Throw it into a function or method and use the function each time you need the code - it will be a lot cleaner.

As addressed by the other answer something like

Public Sub CreateDocument(ByVal templateSheet As Worksheet, ByVal parameterSheet As Worksheet)

And you pass the target worksheets to it. Or maybe you pass the target word document, or whatever changes each time you need to call the sub.

Speaking of the worksheets - Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets("mySheet") and instead just use mySheet.

---

I don't really have the time right now, but it seems you do the exact same thing over and over? I don't see anything changing - all the ranges are hard-coded.

Answer 3

Here's a way to apply some of the tricks the other answers mentioned:

You don't need the TodaysDate line twice, do you?

If RADType = "Full" Then
    TemplatePath = Sheets("Metadata").Range("D8").Value
    NotificationWhenDone = "Full RAD done"
Else
    TemplatePath = Sheets("Metadata").Range("D6").Value
    NotificationWhenDone = "Summary RAD done"
End If
TodaysDate = Now()                                          'Variable called TodaysDate would now contain the current system date and time

Also, why do multiple loops?

'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

    'DONT NEED THIS: Next myStoryRange
    .Application.Selection.EndOf                'Selects until the end of the document

'Write insurer class
    'DONT NEED THIS: For Each myStoryRange In ActiveDocument.StoryRanges
    With myStoryRange.Find
        .Text = "<<InsurerClass>>"
        .Replacement.Text = Industry
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With

    'DONT NEED THIS: Next myStoryRange
    .Application.Selection.EndOf

'Write financial year
    'DONT NEED THIS: For Each myStoryRange In ActiveDocument.StoryRanges
    With myStoryRange.Find
        .Text = "<<CurrentYear>>"
        .Replacement.Text = CurrentYear
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With

    'DONT NEED THIS: Next myStoryRange
    .Application.Selection.EndOf

'Write significant classes
    'DONT NEED THIS: 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