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.
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