VBA code is slow, needs optimization

Question

can anyone help optimize my code not crash my excel? I put it into 3 different macros because it freezes my excel. This was mostly done using the recorder.

Not sure if the culprit is vlookups, big data sets or just because i used the recorder mostly thus I do not have any shortcuts.

Can anyone help combine this code and make it run smoother?

 Sub finalversion1()

''original filter logic

    ActiveSheet.Range("$A$1:$DN$11800").AutoFilter Field:=109, Criteria1:= _
        "=Foreign Exchange Option", Operator:=xlOr, Criteria2:= _
        "=Standalone Cash Ticket Trade"
    Sheets("valumeasure").Select
    ActiveSheet.Range("$A$1:$AB$8134").AutoFilter Field:=9, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "10/31/2040", 0, "12/3/2035", 0, "10/6/2034", 0 _
        , "6/24/2033", 0, "12/29/2032", 0, "6/23/2031", 0, "11/25/2030", 0, "10/9/2029", 0, _
        "11/1/2028", 0, "12/21/2027", 0, "8/31/2026", 0, "11/19/2025", 0, "11/29/2024", 0, _
        "11/14/2023", 0, "12/28/2022", 0, "11/17/2021", 0, "12/14/2020", 0, "12/30/2019", 0, _
        "12/31/2018", 2, "5/17/2017", 2, "5/18/2017", 2, "5/19/2017", 2, "5/22/2017", 2, _
        "5/23/2017", 2, "5/24/2017", 2, "5/25/2017", 2, "5/26/2017", 2, "5/30/2017", 2, _
        "5/31/2017", 1, "6/30/2017", 1, "7/31/2017", 1, "8/30/2017", 1, "9/29/2017", 1, _
        "10/31/2017", 1, "11/30/2017", 1, "12/29/2017")

        End Sub


 Sub finalversion2()

'' vlookup file

    Worksheets("valumeasure").Columns(3).Copy Destination:=Sheets("File").Columns(1)  ''copy and paste filtered values from valuation measure file
    Worksheets("eodcpos").Columns(2).Copy Destination:=Sheets("File").Columns(2)  ''copy and paste filtered values eodc

   ''Looking up into eodc position file
    Worksheets("File").Activate

    Range("C2").Select
    ActiveCell = "=VLOOKUP(A2,B:B,1,FALSE)"
    Selection.AutoFill Destination:=Range("C2:C8278")




    ''starting here we bring in eodc data
    Range("D2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,62,FALSE)"
    Selection.AutoFill Destination:=Range("D2:D8278")
    Range("E2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,17,FALSE)"
    Selection.AutoFill Destination:=Range("E2:E8278")
    Range("F2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,27,FALSE)"
    Selection.AutoFill Destination:=Range("F2:F8278")
    Range("G2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:BK,57,FALSE)"
    Selection.AutoFill Destination:=Range("G2:G8278")
    Range("H2").Select
    ActiveCell = "=VLOOKUP(C2,eodcpos!B:DE,108,FALSE)"
    Selection.AutoFill Destination:=Range("H2:H8278")

    ''now looking up into valuation measure file.

        Range("I2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,7,FALSE)"
    Selection.AutoFill Destination:=Range("I2:I8278")

        Range("J2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,3,FALSE)"
    Selection.AutoFill Destination:=Range("J2:J8278")

     Range("K2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,19,FALSE)"
    Selection.AutoFill Destination:=Range("K2:K8278")

        Range("L2").Select
    ActiveCell = "=VLOOKUP(C2,valumeasure!C:U,8,FALSE)"
    Selection.AutoFill Destination:=Range("L2:L8278")

    ''headers

              End Sub



      Sub finanlversion4()



Dim rng As Range

''sample file creation
Worksheets("Sample File").Activate




''values


    Dim src As Range
    Set src = Worksheets("File").Range("2:8278")

    Dim dst As Range
    Set dst = Worksheets("Sample File").Range("3:8279")

    ' sample file creation
    ' values

    dst.Columns("A") = "CSH"   ' hardcode
    dst.Columns("D") = "1"
    dst.Columns("G") = "USD"
    dst.Columns("J") = "DEALT"
    dst.Columns("N") = "0"

    dst.Columns("B") = src.Columns("D").Value
    dst.Columns("C") = src.Columns("E").Value
    dst.Columns("E") = src.Columns("F").Value
    dst.Columns("F") = src.Columns("F").Value
    dst.Columns("H") = src.Columns("L").Value
    dst.Columns("I") = src.Columns("G").Value
    dst.Columns("M") = src.Columns("I").Value
    dst.Columns("O") = src.Columns("K").Value

    dst.Columns("P") = "=IF(RC[-1]<0,""Y"",""N"")"



End Sub

Start with [this](https://stackoverflow.com/q/10714251/1188513). Then learn how to prevent Excel from constantly repainting itself every time a cell changes. — Mathieu Guindon, Sep 25 '17 at 20:10
Also, when you have code that works as intended, but looks like crap or runs like a snail, you can present it to reviewers on [codereview.se] - with a title that describes the purpose of the code. — Mathieu Guindon, Sep 25 '17 at 20:34
i see that you added the code that i wrote at the end ... sadly, it appears that you did not learn anything from my efforts — jsotola, Sep 26 '17 at 00:54
I'm voting to close this question as off-topic because it belongs on Code Review. — Darren Bartrup-Cook, Sep 26 '17 at 15:39

kolcinx · Answer 1 · 2017-09-25T20:23:38.663

Just to name a few.

Multiple lookups vs one

You are looking up the C2 many times (using VLOOKUP). You can substitute this with ONE lookup using MATCH() function, and use INDEX to retrieve the value.
Note: Also, consider using approximate match, if you can. Such can be only done on clean sorted data, but is waaaay faster.

Copying whole columns

Consider copying only the range with data, not whole columns.

Application.Calculation/Screenupdating

As Mat's Mug correctly pointed out, you should also consider shutting off some of excel application settings, while running the code, and turn them back on again at the end, to do the thing they do just ONCE.
Application.ScreenUpdating Property
Application.Calculation Property

K.Dᴀᴠɪs · Answer 2 · 2017-09-26T15:34:48.507

I will see if I can review the remaining code later, but try to let Excel set your range, and avoid using .Select when changing workbooks. This is untested.

Sub SpeedUpCode(ByVal Value As Boolean)
    If Value = True Then
        With Application
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
        End With
    ElseIf Value = False Then
        With Application
            .ScreenUpdating = True
            .Calculation = xlCalculationAutomatic
        End With
    End If
End Sub

Sub finalversion1()

    ''original filter logic

    Call SpeedUpCode(True)

    Dim Rng1 As Range, Rng2 As Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Sheets(1)    'Not sure of your sheet
    Set ws2 = ThisWorkbook.Sheets("valumeasure")
    Set Rng1 = ws1.UsedRange
    Set Rng2 = ws2.UsedRange

    Rng1.AutoFilter Field:=109, Criteria1:= _
        "=Foreign Exchange Option", Operator:=xlOr, Criteria2:= _
        "=Standalone Cash Ticket Trade"
    Rng2.AutoFilter Field:=9, Operator:= _
        xlFilterValues, Criteria2:=Array(0, "10/31/2040", 0, "12/3/2035", 0, "10/6/2034", 0 _
        , "6/24/2033", 0, "12/29/2032", 0, "6/23/2031", 0, "11/25/2030", 0, "10/9/2029", 0, _
        "11/1/2028", 0, "12/21/2027", 0, "8/31/2026", 0, "11/19/2025", 0, "11/29/2024", 0, _
        "11/14/2023", 0, "12/28/2022", 0, "11/17/2021", 0, "12/14/2020", 0, "12/30/2019", 0, _
        "12/31/2018", 2, "5/17/2017", 2, "5/18/2017", 2, "5/19/2017", 2, "5/22/2017", 2, _
        "5/23/2017", 2, "5/24/2017", 2, "5/25/2017", 2, "5/26/2017", 2, "5/30/2017", 2, _
        "5/31/2017", 1, "6/30/2017", 1, "7/31/2017", 1, "8/30/2017", 1, "9/29/2017", 1, _
        "10/31/2017", 1, "11/30/2017", 1, "12/29/2017")

    Call SpeedUpCode(False)

End Sub

You can call the `Sub SpeedUpCode` at the beginning and the end of all your routines. Just make sure to set the first as `True` (because you want to speed it up), and the second as `False` (because you are finished and don't need it anymore). — K.Dᴀᴠɪs, Sep 25 '17 at 22:21
@excelguy Oh, it should be `ws1.UsedRange`. Also, don't forget to rename `.Sheets(1)` to the correct sheet, as you only specified the sheet name `valumeasure`, not the other one. (Also, add `Option Explicit` to the top of your code and you would have seen that `ws` was not a declared variable ☺) — K.Dᴀᴠɪs, Sep 26 '17 at 13:36
thanks, works really well. Also had to change `Rng1.AutoFilter` its just `rng` in your example — excelguy, Sep 26 '17 at 15:29

VBA code is slow, needs optimization

2 Answers2

Multiple lookups vs one

Copying whole columns

Application.Calculation/Screenupdating