Copy-Pasting (kind of) from Excel to an existing Word table

Question

What I'm trying to do here is to open an Excel file and then search for and store the data I need (i.e if there is a reference then I copy 2 columns). Afterwards, I paste or write that data into a Word table that already exists in my template.

Thus, here is my question: Is there a way to make run faster? It runs in about 21 seconds, and I would like it to be faster because I have plenty of macros to run and if each one runs about 20 seconds then my users won't be satisfied.

Here is the code:

Sub fournitureExcel(trigram As String, nbTable As Long, folderPath As String)

    Dim filename As String, dataRange As String, dataC As New Collection
    Dim refRow As Long, refColumn As Long, desigColumn As Long                     'la ligne de la trigramme recherche
    Dim j As Long, c As Long

    With ActiveDocument

        .Application.ScreenUpdating = False

        On Error Resume Next
            Set xlApp = GetObject(, "Excel.Application")
        If err Then
            Set xlApp = CreateObject("Excel.Application")
        End If
        On Error GoTo 0

        filename = "DE_Nom_art_" & trigram & ".xlsx"
        Set xlBook = xlApp.workbooks.Open(folderPath & filename)
        xlApp.Visible = False   'does not open the file, read only => faster to get the info

        With xlBook.sheets(1)

            ' searching for the Reference
            Set rg = .Cells.Find(what:="Référence")
            refRow = .Range(rg.Address).Row: refColumn = .Range(rg.Address).Column

            Set desigAdrs = .Cells.Find(what:="Désignation")
            'numero de colone Designation
            desigColumn = .Range(desigAdrs.Address).Column: dataRange = "G" & (refRow + 2) & ":I" & 10000
            'stock excel data into a collection
            For Each cell In .Range(dataRange)

                If cell.Column = refColumn Then
                    If Not IsEmpty(cell) Then ' checking if reference exists or not
                        'designation & quantite
                        dataC.Add .Cells(cell.Row, refColumn - 2).Value: dataC.Add .Cells(cell.Row, refColumn - 1).Value
                    End If
                End If
            Next cell
            xlBook.Close SaveChanges:=False                           ' pour ne pas sauvegarder le document
            Set src = Nothing
            Set xlApp = Nothing
            Set xlBook = Nothing
        End With
        'ajoute des lignes a la table fournitures i.e table nr3
        .Tables(nbTable).Select
        c = .Tables(nbTable).Range.Rows.Count
        'c = .Tables(nbTable).Rows.Count
        If c - (dataC.Count / 2) < 0 Then 'check if we need to add rows or not
            With Selection
                    .InsertRowsBelow -(c - (dataC.Count / 2))
                    With .Shading
                        .Texture = wdTextureNone
                        .ForegroundPatternColor = wdColorAutomatic
                        .BackgroundPatternColor = -603914241
                    End With
                    .Font.ColorIndex = wdBlack
                    'ajout des bordures dans le tableau
                    With .Borders
                        .InsideLineStyle = wdLineStyleSingle
                        .OutsideLineStyle = wdLineStyleSingle
                        .InsideColorIndex = wdBlack
                        .OutsideColorIndex = wdBlack
                    End With
            End With
        Else
            ' do nothing
        End If
        j = 3   'indice apartir du quel on va commencer a lire les donnees de la collection car on skip les 2 premiers
        'fill the table
        For i = 2 To dataC.Count / 2
            With .Tables(nbTable).Rows(i)
                ' la  designation & la quantites
                With .Cells(1).Range
                    .Text = dataC(j):
                    .ParagraphFormat.Alignment = wdAlignParagraphLeft 'aligne text to the left
                End With
                .Cells(2).Range.Text = dataC(j + 1)
                With .Range
                    .Font.ColorIndex = wdBlack   'text color :black
                    .Font.Size = 9 '   Set String size = 9
                '   If the string begins with "Baie" then make it Bold
                    If Left(dataC(j), Len("Baie")) = "Baie" Then
                        .Bold = True
                    Else
                        .Bold = False
                    End If
                End With
                j = j + 2
            End With
        Next i
        'ActiveDocument.Tables(3).Rows.Last.Cells.Delete 'on efface la derniere ligne
        .Application.ScreenUpdating = True
    End With
End Sub

Answer 1

A look at the code identifies the key time users:

• starting Excel every time you enter the function
• opening the file
• finding "Référence"
• finding "Désignation"
• looping through a table to do formatting

Two key points I have also picked up on:

• Option Explicit always. I don't know if you have this at the top of the module that holds the routine - but always do it!
• You error check the starting of the Excel application, but you don't error check the opening of the file.

Some suggestions to help manage the performance:

• Open Excel before running all the macros, and pass the reference to the Excel instance as a parameter for each routine. And set the visibility to 'False' as you have done. This should save a few seconds each macro call!
• Only manage the data/content in the function. Leave the formatting until after all the functions have run. This will save effort in repeating formatting.
• Use Word Styles to your advantage. Create a custom style for your table(s) and then apply it at the end (or perhaps even in your template in which case Word should automatically manage your formatting for you). This will reduce the complexity of your functions.
• Bring the Excel data in as an array (Dim X as Variant : X = .Range(dataRange).Value). You can then close the file early and work directly with the values. In your current code you are switching between the Excel model and the VBA model a few times in that loop, which is eating precious cycles. By bringing the data in as an array, you only switch to the Excel model once, and your traversing of the array is all done in the VBA model. This has proven over time to be a good time saver.

Some other hints after looking at the code

You have the following comment: xlApp.Visible = False 'does not open the file, read only => faster to get the info however, this still opens the file, but does not display the application meaning that precious computer cycles are not wasted on rendering a complex display (so yes, it is faster).

Don't use ":" to concatenate lines, it makes the code harder to read. If your code is starting to exceed the VBA module limits, use that as a warning that the code needs some serious review.

You find the reference Row and reference Column, but don't use that information to manage your search range. dataRange should be defined by rows refRow + 2 -> 10000 (not the end row?), and columns desigColumn - 2 -> desigColumn. This then gives us (instead of your For Each cell In .Range(dataRange)):

Dim dataRange as Variant
dataRange = .Range(.Cells(refRow + 2, desigColumn - 2), .Cells(10000, desigColumn)).Value 
'^<-- pulls in an array of the values in that range.

For iterator = LBound(dataRange,1) to UBound(dataRange,1) ' each row
    if datarange(iterator,2) <>"" Then 
        ' 3rd element in that row, 0-based indexing of array
        ' Confirm what checks you need to replicate "IsBlank"
        dataC.Add datarange(iterator,0)
        dataC.Add datarange(iterator,1)
    End If
Next iterator

Consider creating a user-defined Class (instead of a user-defined Type) which will hold the tri-data. Then you can dataC.Add each object into your collection which will remove the need for your /2 calculations. With a common design, you can use the Class across all your macros.