excelguy
excelguy

Reputation: 1624

VBA code is slow, needs optimization

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

Upvotes: 3

Views: 240

Answers (2)

K.Dᴀᴠɪs
K.Dᴀᴠɪs

Reputation: 10139

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

Upvotes: 1

kolcinx
kolcinx

Reputation: 2233

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

Upvotes: 4

Related Questions