Code performance, writing into Word document using VBA

Question

I have an array of strings (15000,2) (approx.) and with the piece of code below I write the strings into a Word document. The code becomes slower and slower the more "rows" of the array I have written to the document. For an array of (1000,2) approx. 4 minutes are needed, for an array of (2000,2) approx. 20 minutes are needed. My problem is that I don´t know how to make the code faster.

Screen updating is turned off.

'Go through every "row" of the array arrDatenGefiltert
For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
    'If the value of the array at the actual "row" and first "column" is not empty...
    If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
        'Write the content of the actual "row" of the array in the document
        With ThisDocument
            'Write the content of the actual "row" and the first "column" in the document
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = arrDatenGefiltert(RowIndex, 0)
                ''Some formatting
                .Font.Size = 11
                .Font.Bold = False
            End With
            'New Paragraph at the end of the document
            .Paragraphs.Add
            'If the second "column" entry is not empty
            If Not arrDatenGefiltert(RowIndex, 1) = "" Then
                'Write the content of the actual "row" and the second "column" in the document
                With .Paragraphs(.Paragraphs.Count).Range
                    .Text = arrDatenGefiltert(RowIndex, 1)
                    'Some formatting
                    .Font.Size = 12
                    .Font.Bold = True
                End With
                'New Paragraph at the end of the document
                .Paragraphs.Add
            End If
            ''Write the content of the actual "row" and the thrid "column" in the document
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = arrDatenGefiltert(RowIndex, 2)
                'Some formatting
                .Font.Size = 12
                .Font.Bold = False
            End With
            'New paragraph at the end of the document
            .Paragraphs.Add
            'Write an additional line at the end of the document (which is the same for every "row" of the array)
            With .Paragraphs(.Paragraphs.Count).Range
                .Text = "*****************"
                'Some formatting
                .Font.Size = 12
                .Font.Bold = False
            End With
            'New paragraph at the end of the document
            .Paragraphs.Add
        End With
    End If
Next RowIndex
'Some formatting for the whole document
ThisDocument.Range(0, 0).Select
Selection.WholeStory
With Selection
    .Font.Color = wdColorBlack
    .Font.Italic = False
    .Font.Name = "Calibri"
    .Font.Underline = wdUnderlineNone
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
End With

Answer 1

I see a few ways to help things along, just glancing at the code:

1. It appears content should be added at the end of the document? Instead of using .Paragraphs(.Paragraphs.Count).Range - which will cause a performance hit for each . - create a Range object and work with that.

For example:

Dim rngEndOfDoc as Word.Range
Set rngEndOfDoc = ActiveDocument.Content
rngEndOfDoc.Collapse wdCollapseEnd
'Add new content here
rngEndOfDoc.Text = "something"
'Collapse it each time new content should be added with different formatting
rngEndOfDoc.Collapse wdCollapseEnd

2. For all text with the same formatting don't use Paragraphs.Add to add a new paragraph. Instead, concatenate the new paragraph into the string using vbCr .

For example:

arrDatenGefiltert(RowIndex, 1) & vbCr & arrDatenGefiltert(RowIndex, 2)

3. This isn't so much performance as correct usage: Don't use ThisDocument unless you explicitly intend to refer only to the document that contains the macro code. Instead, use ActiveDocument or, even better, declare and instantiate a Document object (and using that will be faster).

Example:

Dim doc as Word.Document
Set doc = ActiveDocument

With doc

4. Instead of repeatedly applying multiple actions of direct formatting, use Styles that contain the formatting commands, already. If the code uses a template (rather than creating a new default document) define the styles in the template so new documents created from it inherit the styles. Otherwise, define the styles with the code - applying styles will be faster AND it will avoid possible error messages when Word runs out of memory from storing so many individual formatting commands (for possible Undo actions).

Answer 2

Here is my adjusted code with the suggestions Cindy Meister gave. I went one step further and wrote the whole text in a string, including the paragraph-"signs" and wrote it from there in the Word document. Formatting I did afterwards:

        '''Write the whole content from the strings in the array arrDatenGefiltert in the string strContent
        'For each "row" of the array
        For RowIndex = 0 To lngRowIndex_arrDatenGefiltert
            'If the first "column" of the array is not empty
            If Not arrDatenGefiltert(lngRowIndex_arrDatenGefiltert, 0) = "" Then
                'Write the first "column" of the actual "row" of the array in the string; before, add some unique characters
                strContent = strContent & "%$!First!" & arrDatenGefiltert(RowIndex, 0) & vbCr
                'If the second "column" of the actual "row" of the array is not empty
                If Not arrDatenGefiltert(RowIndex, 1) = "" Then
                    'Write the second "column" of the actual "row" of the array in the string; before, add also some unique characters
                    strContent = strContent & "%$!Second!" & arrDatenGefiltert(RowIndex, 1) & vbCr
                End If
                'Write the third "column" of the actual "row" of the array in the string; before, add also some unique characters
                strContent = strContent & "%$!Thrid!" & arrDatenGefiltert(RowIndex, 2) & vbCr
                ''Write an additional line
                strContent = strContent & "*****************" & vbCr
            End If
        Next RowIndex

        '''Write the value of the string strContent in the Word document
        ActiveDocument.Range(0, 0).Text = strContent

Here is an example for defining a style; I defined three of them. The other two are pretty similar to this one:

    Sub DefineStyleFirst()

        WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""
        WordBasic.FormatStyle Name:="StyleFirst", NewName:="", BasedOn:="", NextStyle:="", Type:=0, FileName:="", link:=""

        With ActiveDocument.Styles("StyleFirst").Font
            .Name = "Calibri"
            .Size = 11
            .Bold = False
            .Italic = False
            .Underline = wdUnderlineNone
            .UnderlineColor = wdColorAutomatic
            .StrikeThrough = False
            .DoubleStrikeThrough = False
            .Outline = False
            .Emboss = False
            .Shadow = False
            .Hidden = False
            .SmallCaps = False
            .AllCaps = False
            .Color = wdColorAutomatic
            .Engrave = False
            .Superscript = False
            .Subscript = False
            .Scaling = 100
            .Kerning = 0
            .Animation = wdAnimationNone
        End With

        With ActiveDocument.Styles("StyleFirst").ParagraphFormat
            .LeftIndent = CentimetersToPoints(0)
            .RightIndent = CentimetersToPoints(0)
            .SpaceBefore = 0
            .SpaceBeforeAuto = False
            .SpaceAfter = 10
            .SpaceAfterAuto = False
            .LineSpacingRule = wdLineSpaceMultiple
            .LineSpacing = LinesToPoints(1.15)
            .Alignment = wdAlignParagraphLeft
            .WidowControl = True
            .KeepWithNext = False
            .KeepTogether = False
            .PageBreakBefore = False
            .NoLineNumber = False
            .Hyphenation = True
            .FirstLineIndent = CentimetersToPoints(0)
            .OutlineLevel = wdOutlineLevelBodyText
            .CharacterUnitLeftIndent = 0
            .CharacterUnitRightIndent = 0
            .CharacterUnitFirstLineIndent = 0
            .LineUnitBefore = 0
            .LineUnitAfter = 0
            .MirrorIndents = False
            .TextboxTightWrap = wdTightNone
        End With

        ActiveDocument.Styles("StyleFirst").NoSpaceBetweenParagraphsOfSameStyle = False
        ActiveDocument.Styles("StyleFirst").ParagraphFormat.TabStops.ClearAll

        With ActiveDocument.Styles("StyleFirst").ParagraphFormat

            With .Shading
                .Texture = wdTextureNone
                .ForegroundPatternColor = wdColorAutomatic
                .BackgroundPatternColor = wdColorAutomatic
            End With

            .Borders(wdBorderLeft).LineStyle = wdLineStyleNone
            .Borders(wdBorderRight).LineStyle = wdLineStyleNone
            .Borders(wdBorderTop).LineStyle = wdLineStyleNone
            .Borders(wdBorderBottom).LineStyle = wdLineStyleNone

            With .Borders
                .DistanceFromTop = 1
                .DistanceFromLeft = 4
                .DistanceFromBottom = 1
                .DistanceFromRight = 4
                .Shadow = False
            End With
        End With

        ActiveDocument.Styles("StyleFirst").NoProofing = False
        ActiveDocument.Styles("StyleFirst").Frame.Delete

    End Sub

Just called in the code like this; right behind the filling of the string strContent:

        DefineStyleFirst
        DefineStyleSecond
        DefineStyleThird

After all these steps, finally the formatting of the text takes place:

        'For each element of the collection "Paragraphs" 
        For Each Element In ActiveDocument.Paragraphs
            'If the first characters of the paragraph are "%$!First!"
            If Left(Element.Range.Text, 9) = "%$!First!" Then
                'The Style of the paragraph is set to "StyleFirst"
                Element.Style = "StyleFirst"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
            End If
            'If the first characters of the paragraph are "%$!Second!"
            If Left(Element.Range.Text, 10) = "%$!Second!" Then
                'The Style of the paragraph is set to "StyleSecond"
                Element.Style = "StyleSecond"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 10)
            End If
            'If the first characters of the paragraph are "%$!Third!"
            If Left(Element.Range.Text, 9) = "%$!Third!" Then
                'The Style of the paragraph is set to "StyleThird"
                Element.Style = "StyleThird"
                'Delete the first characters of the paragraph
                Element.Range.Text = Right(Element.Range.Text, Len(Element.Range.Text) - 9)
            End If
            'If the first characters of the paragraph are "*****************"
            If Left(Element.Range.Text, 17) = "*****************" Then
                'The Style of the paragraph is set to "StyleThird"
                Element.Style = "StyleThird"
            End If
        Next Element