Improving VBA execution speed when writing to a Excel worksheet

[cappy2112]

As a follow-on to this thread:
https://www.mrexcel.com/forum/excel...ing-crazy-trying-get-cell-offset-working.html

Now that I've got my VBA code working, I'm wondering if there is a way to speed it up.
My code reads data from a small (12KB) log file, parses it into VBA collections, then iterates over those collections while writing the
data values to a worksheet. My worksheet has two sets of data, each is 17 rows * 16 columns. Very small compared to some worksheets I've seen. However small, it takes ~ 36 seconds to populate that data.

Is there anything I can do to my code to improve the execution speed? Given that I'm mostly new to VBA scriptiing, I wouldn't be surprise if I'm using a very slow way of populating the worksheet.

My code is below.

Public Sub PopulateWorksheet(PerformanceData As Collection, Sheetname As String)


Const TESTDESCRITEM As Integer = 1
Const DATAITEM As Integer = 2
Const TESTNAMEITEM As Integer = 1
Const IOPSITEM As Integer = 2
Const MBSITEM As Integer = 3


Dim IOPs As String
Dim MBs As Variant
Dim BlkSizeCount As Integer
Dim TestNumberCount As Integer
Dim IOPSRange As Range
Dim MBSRange As Range
Dim RowOffset As Integer
Dim ColOffset As Integer
Dim TestName As String
Dim TestNameFlag As Boolean


' clear the old data
Set IOPSRange = Worksheets("My Try").Range("J8:Y24")
IOPSRange.Clear

' point to the IOPs starting cell
Set IOPSRange = Worksheets("My Try").Range("J8")


'clear the old MB/S data
Set MBSRange = Worksheets("My Try").Range("Z8:AO24")
MBSRange.Clear

' point to the MB/S starting cell
Set MBSRange = Worksheets("My Try").Range("Z8")


BlkSizeCount = 1

For ColOffset = 0 To 15

TestNumberCount = ColOffset + 1

For RowOffset = 0 To 16
'TestName = PerformanceData.Item(TestNumberCount).Item(TESTNAMEITEM)
'If TestNameFlag = False Then
' TestNameFlag = True
' 'Debug.Print TestNumberCount, TestName
'End If


'Populate IOPs
IOPs = PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(IOPSITEM)
IOPSRange.NumberFormat = "General"
IOPSRange.Offset(RowOffset, ColOffset) = CStr(IOPs)

'Populate MB/s
MBs = PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(MBSITEM)
MBSRange.Offset(RowOffset, ColOffset) = CStr(MBs)
MBSRange.NumberFormat = "General"

Next RowOffset

Next ColOffset


End Sub

Thanks in advance.

 

[Zack Barresse]

I don't have your data set, but it would be faster to access the range at one time, rather than through each iteration. There were also some unused variables in your routine. While I don't have a dataset to test with, I'd look at doing something like this instead...

Public Sub PopulateWorksheet( _
       ByVal PerformanceData As Collection, _
       ByVal Sheetname As String _
     )

    Const DATAITEM As Long = 2
    Const IOPSITEM As Long = 2
    Const MBSITEM As Long = 3

    Dim IOPSRange As Range
    Dim MBSRange As Range
    Dim TestNumberCount As Long
    Dim RowOffset As Long
    Dim ColOffset As Long
    Dim IOPValues As Variant
    Dim MBSValues As Variant

    Set IOPSRange = Worksheets("My Try").Range("J8")
    Set MBSRange = Worksheets("My Try").Range("Z8")
    IOPSRange.Resize(18, 16).Clear
    MBSRange.Resize(18, 16).Clear

    For ColOffset = 0 To 15

        TestNumberCount = ColOffset + 1

        For RowOffset = 0 To 16

            If IsEmpty(IOPValues) Then
                ReDim IOPValues(1 To RowOffset, 1 To ColOffset)
                ReDim MBSValues(1 To RowOffset, 1 To ColOffset)
            Else
                ReDim Preserve IOPValues(1 To RowOffset, 1 To ColOffset)
                ReDim Preserve MBSValues(1 To RowOffset, 1 To ColOffset)
            End If

            IOPValues(RowOffset, ColOffset) = CStr(PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(IOPSITEM))
            MBSValues(RowOffset, ColOffset) = CStr(PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(MBSITEM))

        Next RowOffset

    Next ColOffset

    IOPSRange.Resize(UBound(IOPValues, 1), UBound(IOPValues, 2)).Value = IOPValues
    MBSRange.Resize(UBound(MBSValues, 1), UBound(MBSValues, 2)).Value = MBSValues
    IOPSRange.Resize(UBound(IOPValues, 1), UBound(IOPValues, 2)).NumberFormat = "General"
    MBSRange.Resize(UBound(MBSValues, 1), UBound(MBSValues, 2)).NumberFormat = "General"
    
End Sub

 

[cappy2112]

If IsEmpty(IOPValues) Then
ReDim IOPValues(1 To RowOffset, 1 To ColOffset)

Thanks.

When I run your code, the line above causes Subscript Out Of Range error.
Both RowOffset & ColOffset are 0.

 

[Zack Barresse]

Sorry, that ReDim line should have been this...

                ReDim IOPValues(1 To 1, 1 To 1)
                ReDim MBSValues(1 To 1, 1 To 1)

 

[cappy2112]

Sorry, that ReDim line should have been this...

                ReDim IOPValues(1 To 1, 1 To 1)
                ReDim MBSValues(1 To 1, 1 To 1)

Ok,Thanks.

Subscript out of range on this line:
IOPValues(RowOffset, ColOffset) = CStr(PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(IOPSITEM))
(and likely the line following it as well)

 

[Zack Barresse]

Is there any way you can give me an idea of what you are passing as the two variables?

 

[cappy2112]

Is there any way you can give me an idea of what you are passing as the two variables?

Sure- but that shouldn't habe any impact on the array indices, should it?

The log file contains17 sets of these pairs, for each data set.
There are 16 data sets total. But, I've taken care of all that, I'm storing the data for each data set in a Collection.

IOPS ->1.436458e+004 MBS ->7.013954e+000

 

[Zack Barresse]

A collection can house anything. It's easier (and quite a bit faster) to troubleshoot if we know what's actually contained within it.

But I think I see the problem. Your loops are zero-based, my arrays are one-based. Add one to all variables in the array. Like this...

            If IsEmpty(IOPValues) Then
                ReDim IOPValues(1 To RowOffset + 1, 1 To ColOffset + 1)
                ReDim MBSValues(1 To RowOffset + 1, 1 To ColOffset + 1)
            Else
                ReDim Preserve IOPValues(1 To RowOffset + 1, 1 To ColOffset + 1)
                ReDim Preserve MBSValues(1 To RowOffset + 1, 1 To ColOffset + 1)
            End If

            IOPValues(RowOffset + 1, ColOffset + 1) = CStr(PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(IOPSITEM))
            MBSValues(RowOffset + 1, ColOffset + 1) = CStr(PerformanceData.Item(TestNumberCount).Item(DATAITEM).Item(RowOffset + 1).Item(MBSITEM))

The whole point of this making your code more efficient is that you only touch the worksheet twice, once with each array, instead of twice in each iteration (RowOffset * ColOffset). The less you can touch a Range/Cells object, the faster your code will be, keep it all 'in memory', i.e. arrays, and you'll see severe speed increases.

 

[cappy2112]

Thanks.

I agree with you about only touching the worksheet twice. It makes sense.
I've also added Application.Screenupdating = False, outside the loop, and set it back to True after the outer loop. This helps with execution speed too.

I have to start the loops at 0 for the Collections. Microsoft wasn't very smart about the 0 vs 1 from object to object.
I could start at 1, but then would have to do -1 for all of the Collection indices, which I think clutters the code.

I've added the +1 to all of the array indices, but I'm still getting a Subscript Out Of range on -> ReDim Preserve IOPValues(1 To RowOffset + 1, 1 To ColOffset + 1)

 

[Zack Barresse]

I'm out travelling right now, but I think the problem is how I've used the Preserve keyword and how the array is being dimensioned. A rule of using this is only being able to adjust the last element in the array. But we know the dimension of the arrays already, since your array sizes are set. Remove the 'If Isempty()... End If' lines and change your variable dim lines to this:

    Dim IOPValues(1 To 17, 1 To 16) As Variant
    Dim MBSValues(1 To 17, 1 To 16) As Variant