Nsryjdtyk

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

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.

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.

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