VSTO & VBA – Improving Excel’s performance when writing data into Sheets by using memory arrays instead of inefficient code loops


In my previous article (VSTO & VBA - How to troubleshoot Excel memory and performance problems caused by inefficient code loops) I wrote about a few common issues which may be encountered when trying to read data from an Excel workbook using COM automation.

But after you finished reading it, maybe you asked yourself: What about writing data into Excel sheets? Can we optimize that operation too?

The answer is: YES, we generally can use the same techniques. Get a handle to the range of cells you wish to write, process and write the data into a memory array structure and finally, write it in one operation.

Of course, when we want to write data, most of the time we need to format it properly (cell font color, cell borders, size ..etc). Sometimes we also need to write formulas, or we need to search data one cell at a time. Not every operation can be implemented with this approach, but when the situation allows for this optimization, the results are very good.

So, let's start by assuming that we have to write a code which generates a report based on some template which can be customized by the end-user. Thus, the end user is in charge with writing and formatting the column headers and our program has to keep the same look-and-feel and it also has to insert the data. The blank report workbook could look like the one from below:


You may notice that the range [A1:G1] contains the header, and the data has to be inserted starting from row #2. I have highlighted with red markers the cells which have custom formatting applied:
   > cell C2 has its text written in Bold, a light blue Font color and a light
     blue Background;
   > cell F2 had an yellow Background;
   > cell G2 has a text with Italic effect;

The $varX strings from cell C2 are user-defined variables and our code has to dynamically replace them at run-time with numbers. 

First I am going to demonstrate how poor the performance is when we attempt to write the values in sequential mode. To preserve the formatting, I am going to Select our template row [B2:G2], then I am going to execute a Selection.Insert Shift:=xlDown to shift the information one row lower, then the previous level will be filled in with data.


This is the VBA code I used:

Option Explicit

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Test1()
  
    On Error Resume Next
   
    Dim r   As Integer
    Dim c   As Integer
    Dim sht As Worksheet
   
    Dim counter1 As Integer
   
    Dim rowInput  As Integer
    Dim colInput  As Integer
    Dim rngInput  As Range
    Dim rngOutput As Range
    Dim t1        As Long
    Dim t2        As Long
   
    Set sht = ActiveWorkbook.Sheets(1)
   
    Application.ScreenUpdating    = False
    Application.EnableEvents      = False
    Application.Calculation       = xlCalculationManual
    Application.DisplayAlerts     = False
    Application.DisplayStatusBar  = False
   
    counter1 = 0
    t1 = GetTickCount
   
    For r = 2 To 10002
           
      DoEvents
     'select the range used as template
      sht.Range(Cells(r, 1), Cells(r, 8)).Select
            
     'copy the formatting one row down
      Selection.Copy
      Selection.Insert Shift:=xlDown
           
     'save a handle for the row which has to be filled in
      Set rngInput = sht.Range(sht.Cells(r, 2), sht.Cells(r, 7))
           
      For colInput = 1 To 5
          Dim strTmp As String
          Dim strIn  As String
               
          strIn = rngInput.Cells(1, colInput).Value2

         'try to match $var1 and replace it with a dummy value
          If InStr(1, strIn, "$var1") > 0 Then
             strIn    = Replace(strIn, "$var1", counter1)
             counter1 = counter1 + 1
            
            
rngInput.Cells(1, colInput).Value2 = strIn
          End If

         'try to match $var2 and replace it with a dummy value
          If InStr(1, strIn, "$var2") > 0 Then
             strIn    = Replace(strIn, "$var2", (counter1 + 11))
             counter1 = counter1 + 1

             rngInput.Cells(1, colInput).Value2 = strIn
          End If

         'try to match $var3 and replace it with a dummy value
          If InStr(1, strIn, "$var3") > 0 Then
             strIn = Replace(strIn, "$var3", "3")

             rngInput.Cells(1, colInput).Value2 = strIn
          End If
               
      Next
   
      Debug.Print r
    Next r
    t2 = GetTickCount
 
    Debug.Print t1 & " >> " & t2
   
    Application.ScreenUpdating   = True
    Application.EnableEvents     = True
    Application.Calculation      = xlCalculationAutomatic
    Application.DisplayAlerts    = True
    Application.DisplayStatusBar = True

'---------------------------------------------------------------
  Debug.Print "Writing cells sequentially" & vbNewLine
 'Debug.Print "Range.Cells.Count   : " & r * 6
  Debug.Print "Range.Columns.Count : " & 6
  Debug.Print "Range.Rows.Count    : " & r & vbNewLine

  Debug.Print "Operation started at (CPU tick count): " & t1
  Debug.Print "Operation ended at (CPU tick count)  : " & t2
  Debug.Print "Milliseconds duration                : " & t2 - t1

End Sub


First of all I want to let you know that this code is so badly written that it crashed my Excel 2010 around iteration # 200 !!! Then I had to add the DoEvents instruction and I had to disable ScreenUpdating, Event triggers ...etc.


This is the output:

 

Output
===================================================================

Writing cells sequentially

Range.Columns.Count : 6
Range.Rows.Count    : 10003

Operation started at (CPU tick count): 40921230
Operation ended at (CPU tick count)  : 41078354
Milliseconds duration : 157124


OK
, so the badly designed code took 157 seconds (157124 milliseconds) to complete.

Now let's take a look at the optimized version. You will notice that I don't need to use any Excel performance booster (DisableEvents, ScreenUpdating) because it takes too little for anyone to notice my code finished its job 🙂 !

Option Explicit

Public Declare Function GetTickCount Lib "kernel32.dll" () As Long

Sub Test2()
   On Error Resume Next
   Dim arrOut(0 To 10000, 0 To 5) As Variant
  
  'if you want to send Formulas to the sheet, use this code ...
  'arrFor(0, 0) = "=R1C2 + R1C3"
  'arrFor(0, 1) = "=R10C2 + R10C3"
  'arrFor(1, 0) = "=R1C4 + R1C4"
  'arrFor(1, 1) = "=R1C3 + R1C3"
  
  'ActiveSheet.Range("A1:B2").FormulaR1C1 = arrFor
   
    Dim r As Integer
    Dim c As Integer
   
    Dim counter1 As Integer
   
    Dim rowInput  As Integer
    Dim colInput  As Integer
    Dim rngInput  As Range
    Dim rngOutput As Range
    
    Dim t1 As Long
    Dim t2 As Long
  
    Set rngInput = ActiveWorkbook.Sheets(1).Range("A2:H2")
 
   'obtain a handle on the destination range (10000 cells)
    Set rngOutput = ActiveWorkbook.Sheets(1).Range("A3:H10002")
   
    rowInput = 1 
   'the input file has all the data on row 2, columns 2,3,4,5,6

  

    counter1 = 0
    
    t1 = GetTickCount
   
   '--------------------------------------------------------------
   'format the new cells
    rngInput.Select
    Selection.Copy
   
    rngOutput.Select
    Selection.PasteSpecial Paste:=xlPasteFormats, _
              Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    rngInput.Cells(1, 1).Select
    Application.CutCopyMode = False
    
   'build the Array structure line by line
    Set rngInput = ActiveWorkbook.Sheets(1).Range("B2:G2")
    For r = 0 To 10000
        For c = 0 To 5
         
          Dim strTmp As String
          Dim strIn  As String
                
          strIn = rngInput.Cells(rowInput, c + 1).Value
          arrOut(r, c) = strIn
         
         'try to match $var1 and replace it with a dummy value
          If InStr(1, strIn, "$var1") > 0 Then
             strIn    = Replace(strIn, "$var1", counter1)
             counter1 = counter1 + 1
                    
             arrOut(r, c) = strIn
          End If
                
         'try to match $var2 and replace it with a dummy value
          If InStr(1, strIn, "$var2") > 0 Then
             strIn    = Replace(strIn, "$var2", (counter1 + 11))
             counter1 = counter1 + 1
                    
             arrOut(r, c) = strIn
          End If
            
         'try to match $var3 and replace it with a dummy value
          If InStr(1, strIn, "$var3") > 0 Then
             strIn = Replace(strIn, "$var3", "3")

             arrOut(r, c) = strIn
          End If
         
        Next c
    Next r
   
  '---------------------------------------------------------------
  'finished building memory array

'----------------------------------------------------------------
'send the raw data to Excel in one operation
  Set rngOutput = ActiveWorkbook.Sheets(1).Range("B2:G10002")
  rngOutput.Value2 = arrOut
 
'----------------------------------------------------------------
'done!
  t2 = GetTickCount
  
  
  Debug.Print "Writing memory array to destination range" & _
               vbNewLine

  Debug.Print "Range.Cells.Count   : " & rngOutput.Cells.Count
  Debug.Print "Range.Columns.Count : " & rngOutput.Columns.Count
  Debug.Print "Range.Rows.Count    : " & rngOutput.Rows.Count & _
               vbNewLine

  Debug.Print "Operation started at (CPU tick count): " & t1
  Debug.Print "Operation ended at (CPU tick count)  : " & t2
  Debug.Print "Milliseconds duration                : " & t2 - t1
   
End Sub

Output
===================================================================

Writing memory array to destination range

Range.Cells.Count   : 60006
Range.Columns.Count : 6
Range.Rows.Count    : 10001

Operation started at (CPU tick count): 43972391
Operation ended at (CPU tick count)  : 43972984
Milliseconds duration                : 593


The operation was completed 264% faster.

 

As I wrote before, this can't be implemented in every scenario, but when it fits into your design, the improvement in speed will make you love Excel!

 

Thank you for reading my article! Bye 🙂

Skip to main content