how to speed up displaying a massive number of cell updates?

[miless2111s]

I have some code which outputs many values to many cells (around 16 columns and 1000 rows) which takes around a minute to run.

I have been thinking that it was the calculations which were making it slow and have been investigating other options with this forum's help but writing a calculation free script to put out the same sort of volume of information produced a long run time so I suspect I also need to find a way to more quickly output information.

This is the test code:

Sub massive_print()
 Dim wb As Workbook
 Dim ws As Worksheet
 Dim trial As String
 Dim t As Single
 Application.ScreenUpdating = False
 t = timer
 Set wb = ActiveWorkbook
 Set ws = wb.Sheets("trial_print")
 trial = "test entry"
 For i = 1 To 1031
    ws.Range("a" & i).Value = trial
    ws.Range("b" & i).Value = trial
    ws.Range("c" & i).Value = trial
    ws.Range("d" & i).Value = trial
    ws.Range("g" & i).Value = trial
    ws.Range("h" & i).Value = trial
    ws.Range("i" & i).Value = trial
    ws.Range("j" & i).Value = trial
    ws.Range("l" & i).Value = trial
    ws.Range("m" & i).Value = trial
    ws.Range("n" & i).Value = trial
    ws.Range("t" & i).Value = trial
    ws.Range("u" & i).Value = trial
    ws.Range("v" & i).Value = trial
    ws.Range("w" & i).Value = trial
    ws.Range("ae" & i).Value = trial
Next i
ActiveWorkbook.Sheets("Test_scores").Range("h10").Value = timer - t
ActiveWorkbook.Sheets("Test_scores").Range("h09").Value = "time to print 1000 lines:"
Application.ScreenUpdating = True
End Sub

As I am a beginner at all this I wonder if I am going about this in a slow way? Anyone got any ideas? Note that after the first run this output will not all change every time it is run so I don't know if that something that might help in some way???

Many thanks

Miles

 

[miless2111s]

That last part about not needing to change every time gave me an idea (odd how writing things down can do that when messing around on task doesn't help!)... I changed the output section from

ws.Range("a" & i).Value = trial
to
If Not (ws.Range("a" & i).Value = trial) Then ws.Range("a" & i).Value = trial

on the theory that it should check if a change has been made before deciding to overwrite the cell value and it worked to significantly reduce the time taken which is great. It's going to make the code a bit cumbersome but it's a start

I'm still open to ideas though as it seems strange that the writing of information to the cell should take much or any time

TIA

miles

 

[Big Wade]

Interesting question, It took me slightly under half a second (average 0.45) to run your code. Changing your Range("" & i) to Cells(i, "") did improve it by roughly 10% for me.

 

[Chihiro]

Typically I'd leverage one of following method and/or combination of methods.

1. Scripting.Dictionary (when there is unique key field is present and calculation is based on that).
2. Variant Array (put range into array and do calculation and put result into array and put it back into range).

For non contiguous range, you'd need multiple arrays.

Ran test on 3 different codes.
5000 Rows & 26 Columns of data, using simple division (/2) for demo.
Data populated using =Randbetween(1, 10000) then pasted as value.

Following 3 codes used:

Sub arrSpeedTest()
'Sample code demonstrating how fast you can loop through array
'For sample, using value / 2 as calculation
'Sample contains 5000 rows & 26 columns of data


Dim dWs As Worksheet, oWs As Worksheet
Dim i As Long, j As Long
Dim sTime As Single, eTime As Single
Dim resArray As Variant


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")
myArray = dWs.Cells(1, 1).CurrentRegion


ReDim resArray(UBound(myArray, 1) - 2, UBound(myArray, 2) - 1)
For i = 2 To UBound(myArray, 1)
    For j = 1 To UBound(myArray, 2)
        resArray(i - 2, j - 1) = myArray(i, j) / 2
    Next j
Next i


oWs.Cells(2, 1).Resize(UBound(resArray, 1) + 1, UBound(resArray, 2) + 1) = resArray


eTime = Timer
Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Array code took " & eTime - sTime & " seconds"
End Sub


Sub loopCellSpeedTest()
'Sample code doing same calculation by looping cells


Dim dWs As Worksheet, oWs As Worksheet
Dim cel As Range
Dim sTime As Single, eTime As Single


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")


For Each cel In dWs.Range("A1").CurrentRegion.Offset(1)
    oWs.Cells(cel.Row, cel.Column) = cel.Value / 2
Next


eTime = Timer


Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Looping Cells code took " & eTime - sTime & " seconds"


End Sub


Sub simpleLookSpeedTest()
'Instead of looping through cells, looped using column & row index
Dim dWs As Worksheet, oWs As Worksheet
Dim i As Long, j As Long
Dim sTime As Single, eTime As Single


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")


For i = 2 To dWs.Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To dWs.Cells(1, Columns.Count).End(xlToLeft).Column
        oWs.Cells(i, j) = dWs.Cells(i, j).Value / 2
    Next j
Next


eTime = Timer


Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Looping index code took " & eTime - sTime & " seconds"


End Sub

Each code was run for 10 times.

1. Looping through variant Array - Took about 0.1~0.2 seconds
2. Looping through each cell in range - Took 5.2~5.3 seconds
3. Looping through row & column index - took 5.44~5.48 seconds

 

[miless2111s]

good grief that's a heck of a difference! I am on a HP laptop; are you on a super computer?

I'll give the cell() change a go

Thanks for that.

Miles

 

[Chihiro]

I use, msi laptop. 16Gb Ram, i5-4200M CPU @ 2.50GHz.

Variant array is very fast since all calculation is done in memory and is not written to the sheet until last part (instead of updating cell by cell).

Typically looping through Cell (as Range) is slightly faster than looping through index of rows and/or columns.

 

[Chihiro]

FYI - Your slow speed may be do to other calculation/formula present in your workbook as well. I'd set "Application.Calculation = xlCalculationManual" at start of code and reset to "xlCalculationAutomatic" at end.

 

[miless2111s]

Typically I'd leverage one of following method and/or combination of methods.

1. Scripting.Dictionary (when there is unique key field is present and calculation is based on that).
2. Variant Array (put range into array and do calculation and put result into array and put it back into range).

For non contiguous range, you'd need multiple arrays.

Ran test on 3 different codes.
5000 Rows & 26 Columns of data, using simple division (/2) for demo.
Data populated using =Randbetween(1, 10000) then pasted as value.

Following 3 codes used:

Sub arrSpeedTest()
'Sample code demonstrating how fast you can loop through array
'For sample, using value / 2 as calculation
'Sample contains 5000 rows & 26 columns of data


Dim dWs As Worksheet, oWs As Worksheet
Dim i As Long, j As Long
Dim sTime As Single, eTime As Single
Dim resArray As Variant


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")
myArray = dWs.Cells(1, 1).CurrentRegion


ReDim resArray(UBound(myArray, 1) - 2, UBound(myArray, 2) - 1)
For i = 2 To UBound(myArray, 1)
    For j = 1 To UBound(myArray, 2)
        resArray(i - 2, j - 1) = myArray(i, j) / 2
    Next j
Next i


oWs.Cells(2, 1).Resize(UBound(resArray, 1) + 1, UBound(resArray, 2) + 1) = resArray


eTime = Timer
Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Array code took " & eTime - sTime & " seconds"
End Sub


Sub loopCellSpeedTest()
'Sample code doing same calculation by looping cells


Dim dWs As Worksheet, oWs As Worksheet
Dim cel As Range
Dim sTime As Single, eTime As Single


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")


For Each cel In dWs.Range("A1").CurrentRegion.Offset(1)
    oWs.Cells(cel.Row, cel.Column) = cel.Value / 2
Next


eTime = Timer


Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Looping Cells code took " & eTime - sTime & " seconds"


End Sub


Sub simpleLookSpeedTest()
'Instead of looping through cells, looped using column & row index
Dim dWs As Worksheet, oWs As Worksheet
Dim i As Long, j As Long
Dim sTime As Single, eTime As Single


sTime = Timer
Set dWs = ThisWorkbook.Sheets("Data")
Set oWs = ThisWorkbook.Sheets("Output")


For i = 2 To dWs.Cells(Rows.Count, 1).End(xlUp).Row
    For j = 1 To dWs.Cells(1, Columns.Count).End(xlToLeft).Column
        oWs.Cells(i, j) = dWs.Cells(i, j).Value / 2
    Next j
Next


eTime = Timer


Set dWs = Nothing
Set oWs = Nothing
Debug.Print "Looping index code took " & eTime - sTime & " seconds"


End Sub

Each code was run for 10 times.

1. Looping through variant Array - Took about 0.1~0.2 seconds
2. Looping through each cell in range - Took 5.2~5.3 seconds
3. Looping through row & column index - took 5.44~5.48 seconds

There's a lot of new stuff in there for me to understand!

First - what data did you have in the data sheet? So I can set it up and watch it run.

 

[miless2111s]

FYI - Your slow speed may be do to other calculation/formula present in your workbook as well. I'd set "Application.Calculation = xlCalculationManual" at start of code and reset to "xlCalculationAutomatic" at end.

Good grief (stronger words were used but I don't want to offend!) that made a difference - my main code ran in sub 1 second with that simple change!!!!!

What downsides does this have - what do I need to look out for?

 

[Chihiro]

Col1 to Col26 in both sheets for A1:Z1.

In "Data" sheet, A2:Z501 =RANDBETWEEN(1,10000). Copied and pasted as value (just random numbers basically).