CODEWITHSUNDEEP
excelvba
I_K_M
I_K_M

Reputation: 31

VBA code optimization

I have a set of VBA codes which work really perfectly with around of 20 000 x 16 cells. However, I need to use the codes with max 80 000 x 16 cells.

I have identified two types of codes which run really slow:

    c = 2 'this is the first row where your data will output
    d = 2 'this is the first row where you want to check for data

    Application.ScreenUpdating = False


    Do Until Range("A" & c) = "" 'This will loop until column U is empty, set the column to whatever you want
                            'but it cannot have blanks in it, or it will stop looping. Choose a column that is
                            'always going to have data in it.

     ws1.Range("U" & d).FormulaR1C1 = "=RC[-20] & RIGHT(""0000"" & RC[-14], 6)"

     c = c + 1 'Advances a and b when there is a matching case
     d = d + 1

    Loop

    Application.ScreenUpdating = True

End Sub 

Sub OpenValue()    
    Dim l As Integer
    Dim k As Integer
    Dim m As Integer

    m = Sheets("Input").Range("AC:AC").End(xlDown).Row

    For l = 2 To m

    If Range("AC" & l) = "Delievered" Then
       Range("AD" & l) = 0

    ElseIf Range("AC" & l) = "Cancelled" Then
       Range("AD" & l) = 0

    Else
      Range("AD" & l) = Val(Range("Z" & l)) * Val(Range("J" & l))

         End If

    Next

End Sub

What can I do to poptimize them ....

Upvotes: 1

Views: 2061

Answers (2)

xificurC
xificurC

Reputation: 1178

The Do Until can be replaced with a one liner:

ws1.Range("A2", ws1.Range("A2").End(xlDown)).Offset(0,20).FormulaR1C1 = _
    "=RC[-20] & RIGHT(""0000"" & RC[-14], 6)"

Note that this will fail if A3 is empty. If you have headers in row 1 you can change the second A2 to A1.

For the other Sub I'm not sure if you are doing something special with Val but if not you could change it to something similar:

Sub OpenValue()

    Dim r As Range
    Set r = Sheets("Input").Range("AD2:AD" & Sheets("Input").Range("AC1").End(xlDown).Row)
    With r
        .FormulaR1C1 = "=IF(OR(RC[-1]=""Delivered"",RC[-1]=""Cancelled""),0,RC10*RC26"
        'If you want these as values uncomment the following lines
        '.Calculate
        '.Copy
        '.PasteSpecial xlPasteValues
    End With
End Sub

Sprinkle Application stuff around if needed (Calculation, ScreenUpdating, DisplayAlerts, EnableEvents).

Why is this faster:

To put it simply, VBA and Excel have to open a 'channel' to communicate between each other and this costs some time. So looping through a Range and adding formulas one-by-one is much slower for large ranges than doing it all at once since you'll only open the 'channel' once.

Upvotes: 0

Dan Wagner
Dan Wagner

Reputation: 2713

The link provided by @GSerg is an awesome way to cut the running time of your script down. I found myself using:

  • Application.ScreenUpdating set to False
  • Application.Calculation set to xlCalculationManual
  • Application.EnableEvents set to False
  • Application.DisplayAlerts set to False

so often that I combined them into a single public subroutine. @Garys-Student provided the inspiration:

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT         : True or False (i.e. fast or slow)
'DESCRIPTION   : this sub turns off screen updating and alarms then
'                sets calculations to manual
'
Public Sub GoFast(OnOrOff As Boolean)
    Dim CalcMode As XlCalculation
    CalcMode = Application.Calculation
    With Application
        .ScreenUpdating = Not OnOrOff
        .EnableEvents = Not OnOrOff
        .DisplayAlerts = Not OnOrOff
        If OnOrOff Then
            .Calculation = xlCalculationManual
        Else
            .Calculation = CalcMode
        End If
    End With
End Sub

In practice, you can now add the one-liner:

Call GoFast(True)

at the beginning of your script as part of the setup, then add:

Call GoFast(False)

at the end of your script as part of the teardown. Modify as you see fit!

Upvotes: 2

Related Questions