Vba loop speed frustration

[quarna]

Hi.

I am very frustrated with this. i have a small workbook of 992KB with some amount of macro, and some formulas.
Its so slow when running loops, and it only loops 400 columns.

so I have tried running this code in the workbook on a blank sheet. and it is not able to finish, i must force close excel.

Sub looptest()
    Dim rng As Range
    Dim cCell As Range
    Dim i As Long
    Dim xlCalc As XlCalculation

    With Application
        .ScreenUpdating = False
        xlCalc = .Calculation
        .Calculation = xlCalculationManual
        .EnableEvents = False
        .DisplayAlerts = False
    End With
  
    Set rng = Range("A1:A400000")

    i = 1



    Range("C1") = Now()
    For Each cCell In rng
        cCell.Value = i
        i = i + 1
    Next cCell

    Range("C2") = Now()

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
        .Calculation = xlCalc
    End With
End Sub

But if i run the same looptest in a new workbook, it runs at 6 seconds.

 

[Joe4]

Can you explain exactly what it is you are trying to accomplish with your code?
Do you really need to go down to row 400000?

Loops are notoriously slow, and should be avoided whenever you can.
There are probably much better ways of accomplishing what you want to do, if you let us know.

For example, this appears to do the same thing you were trying to do, and runs in less than one second:

Sub MyTest()

    Application.ScreenUpdating = False
    
    Range("C1") = Now()
    
    Range("A1:A400000").Formula = "=Row()"
    Range("A1:A400000").Value = Range("A1:A400000").Value
    
    Range("C2") = Now()
        
    Application.ScreenUpdating = True
    
End Sub

 

[nemmi69]

Some of it it going to be dependent on available memory at the time. On my machine it only takes 3 seconds.

 

[quarna]

Can you explain exactly what it is you are trying to accomplish with your code?
Do you really need to go down to row 400000?

Loops are notoriously slow, and should be avoided whenever you can.
There are probably much better ways of accomplishing what you want to do, if you let us know.

For example, this appears to do the same thing you were trying to do, and runs in less than one second:

Sub MyTest()

    Application.ScreenUpdating = False
   
    Range("C1") = Now()
   
    Range("A1:A400000").Formula = "=Row()"
    Range("A1:A400000").Value = Range("A1:A400000").Value
   
    Range("C2") = Now()
       
    Application.ScreenUpdating = True
   
End Sub

The code below takes the range "rg" and saves it to columns in a sigle row but it takes like 8-10 seconds

Sub gemKerner()

    r = 1 
    k = 53 
    id = shKerneOplysninger.Range("C4").Value
    
    Dim rg As Range
    Set rg = shKerneOplysninger.Range("M5:V44") 
    Dim arr As Variant
    arr = rg.Value
    
    Do While shKerneData.Cells(r, 1).Value <> ""
        If shKerneData.Cells(r, 1).Value = id Then
            
            For i = LBound(arr, 1) To UBound(arr, 1)
                For j = LBound(arr, 2) To UBound(arr, 2)
                    shKerneData.Cells(r, k) = arr(i, j)
                    k = k + 1
                Next j
            Next i
           
        End If
      r = r + 1
    Loop
End Sub

But when i take it back to the range it takes under 1 second with the code below, that is super frustrating and makes no sense to me. ?

Sub hentKerner()
    
    r = 1 
    k = 53
    id = shKerneOplysninger.Range("C4").Value
    flag = False
   
    Dim rg As Range
    Set rg = shKerneOplysninger.Range("M5:V44") 
    Dim arr As Variant
    
    Do While shKerneData.Cells(r, 1).Value <> ""
        If shKerneData.Cells(r, 1).Value = id Then
            flag = True
            ReDim arr(1 To 40, 1 To 10)
                For i = LBound(arr, 1) To UBound(arr, 1)
                    For j = LBound(arr, 2) To UBound(arr, 2)
                        arr(i, j) = shKerneData.Cells(r, k)
                        k = k + 1
                    Next j
                Next i
            rg.value = arr
        End If
    r = r + 1
    Loop
    If flag = False Then Exit Sub
End Sub

 

[Alex Blakenburg]

Not sure we can blame it all on the looping. If you use an array for the initial example and still use a loop it is takes half the time that @Joe4 range formula approach takes.
In the last post I believe the issue is that the first piece of code "writes" out 1 cell at a time here:

shKerneData.Cells(r, k) = arr(i, j)

While the 2nd piece of code writes it out in a single block here:

rg.value = arr

If you want to provide us some sample data using XL2BB for both sheets and a description of what you are trying to achieve I am sure we can get your first one to run in under 1 sec too.

And my array test was:

Sub test_Using_array()

    Dim rng As Range
    Dim arr As Variant
    Dim i As Long, j As Long
    Dim startTime As Double
    startTime = Timer
   
    Range("D1") = Now()
    Set rng = Range("A1:A400000")
    arr = rng
   
    For i = 1 To UBound(arr)
        ' tried it with and without using this extra calculation only slightly slower with it in
        j = j + 1
        arr(i, 1) = j
    Next i
    rng.Value = arr
   
    Range("D2") = Now()
    Range("D3") = Timer - startTime

End Sub

 

[quarna]

Hi again.

So i was going through my workbook to find out why the loop thing was so slow, because in a new workbook, the same loop code worked fine.
I found out that.

On another sheet i have a dynamic image formula for showing signatures when printing. Even though the loop code has nothing to do with that, it still does mess up my speed.
Maybe because its a 32bit version ?

The image code thing are from this site.

3 ways to change or insert images based cell values - Excel Off The Grid

Stock parts, holiday villas or employees; there are lots of reasons to change an image based on a cell value. This tutorial will show you how.

exceloffthegrid.com

When i delete this function the loop speed is normal..
Go figure and really annoying.

 

[Alex Blakenburg]

Thanks for letting us know. Joe's code turns off ScreenUpdating at the beginning and back on at the end.
It doesn't look like you have that in the code you are showing us. Does it make any difference if you add that in and turn off screen updating ?

 

[quarna]

Thanks for letting us know. Joe's code turns off ScreenUpdating at the beginning and back on at the end.
It doesn't look like you have that in the code you are showing us. Does it make any difference if you add that in and turn off screen updating ?

Yes i have these before the code. It makes no difference.

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

 

[RoryA]

Linked pictures have always been an issue for VBA speed. One option is to use a flag in the link formula (eg if A1=1,link here,false) then set a1 to something other than 1 at the start of the code, then back to 1 at the end.

 

[quarna]

Thanks for your time everybody.

I found a solution i believe works. When ever i need to print i use this code.

shUdskrift.Shapes("Signature_image").Select
Selection.Formula = "=Signature"

And when print is finished i revert it back to blank.

shUdskrift.Shapes("Signature_image").Select
Selection.Formula = ""

Thanks for all your inputs.