Very slow Macro, need help speeding it up

J

jrwrita

Board Regular
Joined
May 7, 2015
Messages
206
Hi,

Below is my code, is there anyone who can help optimize this?


Code: 
Sub filtering()
'


' filtering Macro
'



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

    Set ws1 = ThisWorkbook.Sheets("eodcpos")
    Set ws2 = ThisWorkbook.Sheets("valumeasure3")
    Set ws3 = ThisWorkbook.Sheets("File")

    Set ws4 = ThisWorkbook.Sheets.Add
    ws4.Name = "lookup"
    
    Set ws5 = ThisWorkbook.Sheets("Sample File")
    
    Set Rng1 = ws1.UsedRange
    Set Rng2 = ws2.UsedRange
    Set src = Worksheets("File").Range("2:757")
    Set src1 = Worksheets("lookup").Range("2:17783")
    Set src2 = Worksheets("Sample File").Range("2:757")

'
   Rng1.AutoFilter Field:=11, Criteria1:= _
        "=Traded Position"
        
  Rng1.AutoFilter Field:=2, Criteria1:= _
        "<>*-C*", Operator:=xlAnd, Criteria2:="<>*-P*"
    
    Rng1.AutoFilter Field:=109, Criteria1:=Array _
        ("Foreign Exchange Forward", "Foreign Exchange Spot", "Foreign Exchange Swap"), _
        Operator:=xlFilterValues
              
    Rng1.AutoFilter Field:=33, Criteria1:= _
        "<>NA"
       
    Rng1.AutoFilter Field:=63, Criteria1:= _
        "<>129540", Operator:=xlAnd, Criteria2:="<>135845"
         
    Rng2.AutoFilter Field:=5, Criteria1:= _
        "=Buy Notional Amount", Operator:=xlOr, Criteria2:="=Sell Notional Amount"
    
    '' vlookup file
    
        ws4.Activate
        
        Range("A1").Value = "val pos id"
        ws2.Columns(3).Copy Destination:=Sheets("lookup").Columns(1)
        ws4.Range("A:A").RemoveDuplicates Columns:=Array(1)
        
        Range("B1").Value = "eodc pos id"
        ws1.Columns(2).Copy Destination:=Sheets("lookup").Columns(2)
        Range("C1").Value = "eodc pos decor id"
        ws1.Columns(41).Copy Destination:=Sheets("lookup").Columns(3)
        
        Range("D1").Value = "pos id lookup"
        Range("D2").Select
        ActiveCell = "=VLOOKUP(A2,B:B,1,FALSE)"
        Selection.AutoFill Destination:=src1.Columns("D")
        
        
        Range("E1").Value = "pos decor id lookup"
        Range("E2").Select
        ActiveCell = "=VLOOKUP(fxpd!B2,C:C,1,FALSE)"
        Selection.AutoFill Destination:=src1.Columns("E")
        
        ''Filtering File data
        ws4.UsedRange.AutoFilter Field:=4, Criteria1:= _
        "<>#N/A"
       
       ''creating File tab
        ws4.Columns(4).Copy Destination:=Sheets("File").Columns(1)  ''copy and paste filtered values from valuation measure file
        ws4.Columns(5).Copy Destination:=Sheets("File").Columns(2)  ''  copy and paste filtered values from fxpd
        
        ws3.Activate
        
        
        Range("X2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BP,COLUMNS(B:BP),FALSE)"   ''product classification code
        Selection.AutoFill Destination:=src.Columns("X")
        
     '' ActiveCell.FormulaR1C1 = _
     ''   "=IF(RIGHT(LEFT(RC[20],64),40)=""ProductType:'FXD';ProductSubType:'SWLEG'"",""XSW"",IF(RIGHT(LEFT(RC[20],64),40)=""ProductType:'FXD';ProductSubType:'FXD'"",""FXD"",""NA""))"
     ''  Range("D2").Select
     ''   Selection.AutoFill Destination:=src.Columns("D")
    
        Range("D2").Select
        ActiveCell = "=IF(RIGHT(LEFT(X2,64),40)=""ProductType:'FXD';ProductSubType:'SWLEG'"",""XSW"",IF(RIGHT(LEFT(X2,64),38)=""ProductType:'FXD';ProductSubType:'FXD'"",""FXD"",""NA""))"
        Selection.AutoFill Destination:=src.Columns("D")
        
        Range("E2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"   ''counterparty short name  / client id
        Selection.AutoFill Destination:=src.Columns("E")
        Range("F2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,17,FALSE)"  ''source trade id  / deal id
        Selection.AutoFill Destination:=src.Columns("F")
        Range("G2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,27,FALSE)"   ''trade date / contract date
        Selection.AutoFill Destination:=src.Columns("G")
        Range("H2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:V,COLUMNS(B:V),FALSE)"   ''settlement date / actual settlement date
        Selection.AutoFill Destination:=src.Columns("H")
        Range("I2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BG,COLUMNS(B:BG),FALSE)"   ''book runner / source book name
        Selection.AutoFill Destination:=src.Columns("I")

''lookup into fxpd now

          Range("J2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:AO,COLUMNS(B:AO),FALSE)"   ''pull in pos decorator id
        Selection.AutoFill Destination:=src.Columns("J")
             Range("K2").Select
        ActiveCell = "=VLOOKUP(B2,fxpd!B:U,COLUMNS(B:U),FALSE)"   ''spot rate / forward rate
        Selection.AutoFill Destination:=src.Columns("K")
             Range("L2").Select
        ActiveCell = "=VLOOKUP(B2,fxpd!B:U,COLUMNS(B:U),FALSE)"
        Selection.AutoFill Destination:=src.Columns("L")        ''outright rate / forward rate
            
            Range("M2").Select
        ActiveCell = "=VLOOKUP(B2,fxpd!B:I,COLUMNS(B:I),FALSE)"   ''buy currency code / buy curency
        Selection.AutoFill Destination:=src.Columns("M")
         Range("N2").Select
        ActiveCell = "=VLOOKUP(B2,fxpd!B:AK,COLUMNS(B:AK),FALSE)"   ''sell currency code / sell curency
        Selection.AutoFill Destination:=src.Columns("N")
        
        
        

        src.Columns("O") = "LIVE"  ''hardcode type name
        src.Columns("P") = "1"  ''hardcode leg number
        src.Columns("Q") = "S"  ''hardcode leg duration code
        src.Columns("R") = ""  ''hardcode option value date



         Range("S2").Select
       '' ActiveCell = "=IF(valumeasure3!E2=""Buy Notional Amount"",VLOOKUP(A2,valumeasure3!C:U, COLUMNS(C:U),FALSE),0)"
        ActiveCell = "=SUMIFS(valumeasure3!U:U,valumeasure3!C:C,File!A2,valumeasure3!E:E,""Buy Notional Amount"")"    ''buy currency amt
        Selection.AutoFill Destination:=src.Columns("S")
        
        
          Range("T2").Select
       '' ActiveCell = "=IF(valumeasure3!E2=""Sell Notional Amount"",VLOOKUP(A2,valumeasure3!C:U, COLUMNS(C:U),FALSE),0)"
        ActiveCell = "=SUMIFS(valumeasure3!U:U,valumeasure3!C:C,File!A2,valumeasure3!E:E,""Sell Notional Amount"")"  ''sell curency amt
        Selection.AutoFill Destination:=src.Columns("T")
        
            Range("U2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:I,8,FALSE)"   ''setup for buy risk currency flag
        Selection.AutoFill Destination:=src.Columns("U")

         
            Range("V2").Select
        ActiveCell = "=IF(U2=""Long"",""B"",""S"")"   ''buy risk currency flag
        Selection.AutoFill Destination:=src.Columns("V")
        
         Range("W2").Select
        ActiveCell = "=IF(S2<>""0"",T2/S2,""0"")"   ''
        Selection.AutoFill Destination:=src.Columns("W")

       

''headers
        Range("C1").Value = ""
         Range("D1").Value = "Product Family Name"
           Range("E1").Value = "Client name"
              Range("F1").Value = "deal ID"
                 Range("G1").Value = "trade Date"
                    Range("H1").Value = "settlement"
                       Range("I1").Value = "source book"
                          Range("J1").Value = "PD ID"
                             Range("K1").Value = "forward rate"
                                Range("L1").Value = "forward rate"
                                 Range("M1").Value = "buy currency"
                                        Range("N1").Value = "sell currency"
                                           Range("O1").Value = "type name"
                                               Range("P1").Value = "leg number"
                                                   Range("Q1").Value = "duration"
                                                           Range("R1").Value = "option value date"
                                                                Range("S1").Value = "buy ccy amt"
                                                                         Range("T1").Value = "sell ccy amt"
                                                                            Range("U1").Value = "N/A"
                                                                            Range("V1").Value = "buy risk ccy flag"
                                                                            Range("W1").Value = "sell buy ratio"
                                                                            

   ws5.Activate
       
            
                
     
     
     ws3.Columns(4).Copy
        Sheets("Sample File").Columns(1).PasteSpecial xlPasteValues
         ws3.Columns(5).Copy
        Sheets("Sample File").Columns(2).PasteSpecial xlPasteValues
            ws3.Columns(6).Copy
        Sheets("Sample File").Columns(3).PasteSpecial xlPasteValues
        src2.Columns("D") = "1"
           ws3.Columns(7).Copy
        Sheets("Sample File").Columns(5).PasteSpecial xlPasteValues
          ws3.Columns(8).Copy
        Sheets("Sample File").Columns(6).PasteSpecial xlPasteValues
           ws3.Columns(9).Copy
        Sheets("Sample File").Columns(7).PasteSpecial xlPasteValues
               src2.Columns("H") = "LIVE"  ''hardcode type name
        src2.Columns("I") = "1"  ''hardcode leg number
        src2.Columns("J") = "S"  ''hardcode leg duration code
           ws3.Columns(11).Copy
        Sheets("Sample File").Columns(11).PasteSpecial xlPasteValues
        ws3.Columns(11).Copy
        Sheets("Sample File").Columns(12).PasteSpecial xlPasteValues
        ws3.Columns(13).Copy
        Sheets("Sample File").Columns(13).PasteSpecial xlPasteValues
        ws3.Columns(14).Copy
        Sheets("Sample File").Columns(14).PasteSpecial xlPasteValues
        ws3.Columns(19).Copy
        Sheets("Sample File").Columns(15).PasteSpecial xlPasteValues
          ws3.Columns(20).Copy
        Sheets("Sample File").Columns(16).PasteSpecial xlPasteValues
          ws3.Columns(22).Copy
        Sheets("Sample File").Columns(17).PasteSpecial xlPasteValues
       src2.Columns("R") = "" ''hardcode option value date
         ws3.Columns(23).Copy
        Sheets("Sample File").Columns(19).PasteSpecial xlPasteValues
        
         'headers for Sample File sheet
     Range("A1").Value = "Product Family Name"
     Range("B1").Value = "Client Name"
        Range("C1").Value = "Deal ID"
         Range("D1").Value = "Amendment Number"
           Range("E1").Value = "Trade Date"
              Range("F1").Value = "Settlement Date"
                 Range("G1").Value = "Book Runner"
                    Range("H1").Value = "Leg Status Type Name"
                       Range("I1").Value = "Leg Number"
                          Range("J1").Value = "Leg Duration Code"
                             Range("K1").Value = "Spot Rate"
                                Range("L1").Value = "Outright Rate"
                                 Range("M1").Value = "Buy Currency Code"
                                        Range("N1").Value = "Sell Currency Code"
                                           Range("O1").Value = "Buy Currency Amt"
                                               Range("P1").Value = "Sell Currency Amt"
                                                   Range("Q1").Value = "Buy Risk Currency Flag"
                                                           Range("R1").Value = "Option Value Date"
                                                            Range("S1").Value = "Sell Buy Ratio"
       
   End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Sort by date Sort by votes
Not sure of how much help it would be but I always include

Code: 
Application.ScreenUpdating = False

At the beginning of a code and

Code: 
Application.ScreenUpdating = True

at the end

you might also consider turning calculations off

Code: 
Application.Calculation = xlManual
'
'
Your code here
'
'
Calculate
Application.Calculation = xlAutomatic
 
Upvote 0
@ jrwrita, do you really need to apply your formula to the entire column? can you not just fill them to the last row with data?

i.e (assuming that your longest column is column A).....


near the top of your code put
Code: 
Dim lstrw As Long
lstrw = Cells(Rows.Count, "A").End(xlUp).Row

then with all your code like
Code: 
        Range("E2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"   ''counterparty short name  / client id
        Selection.AutoFill Destination:=src.Columns("E")

change it to
Code: 
Range("E2:E" & lstrw).Formula = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"
 
Last edited:
Upvote 0
MARK858 said:
@ jrwrita, do you really need to apply your formula to the entire column? can you not just fill them to the last row with data?

i.e (assuming that your longest column is column A).....


near the top of your code put
Code: 
Dim lstrw As Long
lstrw = Cells(Rows.Count, "A").End(xlUp).Row

then with all your code like
Code: 
        Range("E2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"   ''counterparty short name  / client id
        Selection.AutoFill Destination:=src.Columns("E")

change it to
Code: 
Range("E2:E" & lstrw).Formula = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"
Click to expand...

cool, ill try this. but how does this differ from just filling down normally?
 
Upvote 0
It applies the formula in one go and most importantly with your code it doesn't use Select, Selection or ActiveCell which all slow the code down.
 
Upvote 0
MARK858 said:
@ jrwrita, do you really need to apply your formula to the entire column? can you not just fill them to the last row with data?

i.e (assuming that your longest column is column A).....


near the top of your code put
Code: 
Dim lstrw As Long
lstrw = Cells(Rows.Count, "A").End(xlUp).Row

then with all your code like
Code: 
        Range("E2").Select
        ActiveCell = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"   ''counterparty short name  / client id
        Selection.AutoFill Destination:=src.Columns("E")

change it to
Code: 
Range("E2:E" & lstrw).Formula = "=VLOOKUP(A2,eodcpos!B:BK,62,FALSE)"
Click to expand...

I would suggest

Code: 
Selection.AutoFill Destination:=Range("E2:E" & lstrw)

Also since we do not know if Column A is the largest I would suggest

Code: 
lstrw = ActiveSheet.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row
 
Upvote 0
This line
Code: 
lstrw = Cells(Rows.Count, "A").End(xlUp).Row
Needs to be below
Code: 
ws3.Activate
@Truiz, I would agree with the change if the OP doesn't know which column is longest but if they do then I prefer to specify it (just my preference) and I think it is very likely it is column A as the OP uses it in the VLOOKUP.
 
Last edited:
Upvote 0
I use the following code in (almost) all of my macros

Code: 
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
'code goes here
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True

You can also disable calculations in the same manner. For whatever reason that one has given me problems though.
 
Last edited:
Upvote 0
jbenfleming said:
You can also disable calculations in the same manner. For whatever reason that one has given me problems though.
Click to expand...

The only reason I can think that disabling calculations can cause problems is if there are cells that need to be calculated in a set order, in the OP's case it is probably highly beneficial to disable them while the code runs rather than having each dependent formula cell recalculate during the code running.

As for Application.EnableEvents = False then I only use it if there are Events in my codes rather than use it generically (plus there are some times when you do need them to trigger when code runs).

Strictly speaking you should record the state at the start of the code and then return them to the original state at the end rather than assume they were all true, something like...


Code: 
Sub SpeedUpAll()

Dim screenUpdateState As Boolean, statusBarState As Boolean
Dim CalcState, eventsState As Boolean, displayPageBreaksState As Boolean

displayPageBreaksState = ActiveSheet.DisplayPageBreaks

  With Application
   screenUpdateState = .ScreenUpdating
      statusBarState = .DisplayStatusBar
           CalcState = .Calculation
         eventsState = .EnableEvents

                       .ScreenUpdating = False
                       .DisplayStatusBar = False
                       .Calculation = xlCalculationManual
                       .EnableEvents = False
  End With
 ActiveSheet.DisplayPageBreaks = False
 
[COLOR="#006400"]' Code to run here[/COLOR]
  
  With Application
        .ScreenUpdating = screenUpdateState
        .DisplayStatusBar = statusBarState
        .Calculation = CalcState
        .EnableEvents = eventsState
  End With

ActiveSheet.DisplayPageBreaks = displayPageBreaksState
End Sub

Although I am as bad as most others for not doing this :biggrin:
 
Last edited:
Upvote 0
i did the last row, that helped, will the one above help (post #9 ) ? not sure whether to use it as there seems to be some conflict between posters.
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
My code is suddenly really slow
Replies
1
Views
369
RobP
R
I
  • Solved
Current Code taking 10 Hours to run. Need Help to Optimize
Replies
5
Views
512
ItalianPlatinum
I
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
584
RoryA
RoryA
M
  • Question Question
Cleaning up Code
Replies
0
Views
796
MHamid
M
B
  • Question Question
Need help with VBA sumif function
Replies
1
Views
640
sijpie
sijpie

Forum statistics

Threads
1,223,893
Messages
6,175,240
Members
452,621
Latest member
Laura_PinksBTHFT

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top