Slow VBA macro writing in cells

Question

I have a VBA macro, that writes in data into a cleared out worksheet, but it's really slow!

I'm instantiating Excel from a Project Professional.

Set xlApp = New Excel.Application
xlApp.ScreenUpdating = False
Dim NewBook As Excel.WorkBook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
     .Title = "SomeData"
     Set ws = NewBook.Worksheets.Add()
     ws.Name = "SomeData"
End With

xlApp.Calculation = xlCalculationManual 'I am setting this to manual here

RowNumber=2
Some random foreach cycle
    ws.Cells(RowNumber, 1).Value = some value
    ws.Cells(RowNumber, 2).Value = some value
    ws.Cells(RowNumber, 3).Value = some value
             ...............
    ws.Cells(RowNumber, 12).Value = some value
    RowNumber=RowNumber+1
Next

My problem is, that the foreach cycle is kinda big. At the end, I'll get around 29000 rows. It takes more than 25 minutes to do this on a pretty OK computer.

Are there any tricks to speed up the writing to the cells? I've done the following:

xlApp.ScreenUpdating = False
xlApp.Calculation = xlCalculationManual

Am I referencing the cells in a wrong way? Would it be possible, to write in a whole row, instead of the single cells?

Would that be faster?

I've tested my code, the foreach cycle goes through pretty quicky (i wrote the values into some random variables), so I know, that writing into the cells is what takes up all this time.

If you need further information, code snipplets please let me know.

Thank you for your time.

Answer 1

Would it be possible, to write in a whole row, instead of the single cells? Would that be faster?

Yes and yes. This is exactly where you can improve performance. Reading/writing to cells is notoriously slow. It matters very little how many cells you are reading/writing, but rather how many calls you are making to the COM object to do so. Therefore read and write your data in blocks utilizing two-dimensional arrays.

Here is an example procedure that writes MS Project task data to Excel. I mocked up a schedule with 29,000 tasks and this runs in a few seconds.

Sub WriteTaskDataToExcel()

Dim xlApp As Excel.Application
Set xlApp = New Excel.Application
xlApp.Visible = True

Dim NewBook As Excel.Workbook
Dim ws As Excel.Worksheet
Set NewBook = xlApp.Workbooks.Add()
With NewBook
     .Title = "SomeData"
     Set ws = NewBook.Worksheets.Add()
     ws.Name = "SomeData"
End With

xlApp.ScreenUpdating = False
Dim OrigCalc As Excel.XlCalculation
OrigCalc = xlApp.Calculation
xlApp.Calculation = xlCalculationManual

Const BlockSize As Long = 1000
Dim Values() As Variant
ReDim Values(BlockSize, 12)
Dim idx As Long
idx = -1
Dim RowNumber As Long
RowNumber = 2
Dim tsk As Task
For Each tsk In ActiveProject.Tasks
    idx = idx + 1
    Values(idx, 0) = tsk.ID
    Values(idx, 1) = tsk.Name
    ' populate the rest of the values
    Values(idx, 11) = tsk.ResourceNames
    If idx = BlockSize - 1 Then
        With ws
            .Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
        End With
        idx = -1
        ReDim Values(BlockSize, 12)
        RowNumber = RowNumber + BlockSize
    End If
Next
' write last block
With ws
    .Range(.Cells(RowNumber, 1), .Cells(RowNumber + BlockSize - 1, 12)).Value = Values
End With
xlApp.ScreenUpdating = True
xlApp.Calculation = OrigCalc

End Sub

Answer 2

Do it like this:

ws.Range(Cells(1, RowNumber), Cells(12, Number))=arr 

Where arr is an array of your some value values e.g.

Dim arr(1 to 100) as Long

Or if possible (even faster):

ws.Range(Cells(firstRow, RowNumber), Cells(lastRow, Number))=twoDimensionalArray 

Where twoDimensionalArray is a 2 dimensional array of your some value values e.g.

Dim twoDimensionalArray(1 to [your last row], 1 to 12)  as Long