Largest part of code VB formulas speed issues

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
78
Hi, I have quite a large VB, and after digging into my code, the calculations seem to be taken the longest.

VBA Code:
Application.DisplayAlerts = False
Application.CutCopyMode = False 'Clearing the Office Clipboard
Application.ScreenUpdating = False    ' This turns the screen updating off while the macro runs, helps with speed
Application.EnableEvents = False      ' Disables events, so commands where you need to press OK
ActiveSheet.DisplayPageBreaks = False ' Disables page breaks as we wont be printing any data
'Application.Calculation = xlManual    ' Turn Off Automatic calulations in Excel





Sheets("Parked Report").Select
Range("N1").Value = "Vendor Name"
Range("O1").Value = "Days Overdue"
Range("P1").Value = "Assigned To"
Range("Q1").Value = "Agent Email"
Range("R1").Value = "User Company"
Range("S1").Value = "Region"
Range("T1").Value = "Scan Date"
Range("U1").Value = "Invoice Amount"
Range("V1").Value = "USD"
Range("W1").Value = "Scan Date (Aging)"
Range("X1").Value = "Status"
Range("Y1").Value = "Overdue (Aging)"
Range("Z1").Value = "Critical /Non Critical"
Range("AA1").Value = "Query User"
Range("AB1").Value = "Comment Date"
Range("AC1").Value = "Standard Comment"
Range("AD1").Value = "Open Comment"
Range("AE1").Value = "Status 2"
Range("AR1").Value = "Type Of Contact"


Range("N2").Select   '- Vendor Name column
    Selection.FormulaArray = _
        "=IFERROR(INDEX(Parked!C[-10],MATCH(1,('Parked Report'!RC[-13]=Parked!C[-13])*('Parked Report'!RC[-11]=Parked!C[-11])*('Parked Report'!RC[-10]=Parked!C[-9]),0)),""Vendor Not Defined"")"
            last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
            Selection.AutoFill Destination:=Range("N2:N" & last_row)
            Erase Array()

Range("O2").Select '"Days Overdue"
    ActiveCell.Formula = "=IF(K2<0,-K2,K2)"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("O2:O" & last_row)
       
Range("P2").Select '"Assigned To"
    Selection.FormulaArray = _
        "=IFERROR(INDEX(Parked!C[-8],MATCH(1,('Parked Report'!RC[-15]=Parked!C[-15])*('Parked Report'!RC[-13]=Parked!C[-13])*('Parked Report'!RC[-11]=Parked!C[-14]),0)),""Agent not Defined"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
         Selection.AutoFill Destination:=Range("P2:P" & last_row)
         Erase Array()

Range("Q2").Select '"Agent Email"
    ActiveCell.FormulaR1C1 = _
         "=IFERROR(INDEX('User List'!C[-13],MATCH('Parked Report'!RC[-1],'User List'!C[-15],0)),""Agent Email Not Defined"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("Q2:Q" & last_row)
       
Range("R2").Select 'User Company
        ActiveCell.FormulaR1C1 = _
           "=IFERROR(INDEX('User List'!C[-15],MATCH('Parked Report'!RC[-1],'User List'!C[-14],0)),""Agent Company Not Assigned"")"
             last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
            Selection.AutoFill Destination:=Range("R2:R" & last_row)
              
Range("S2").Select 'Region
    ActiveCell.FormulaR1C1 = _
        "=IF(OR(LEFT(RC[-18],2)=""US"",LEFT(RC[-18],2)=""CA"",LEFT(RC[-18],2)=""CR""),""NOAM"",""EMEA"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("S2:S" & last_row)

Range("T2").Select 'Scan Date
Selection.FormulaArray = _
        "=IFERROR(INDEX(SQ00QR_Query!C[-3],MATCH(1,('Parked Report'!RC[-19]=SQ00QR_Query!C[-18])*('Parked Report'!RC[-17]=SQ00QR_Query!C[-19])*('Parked Report'!RC[-16]=SQ00QR_Query!C[-17]),0)),""Scan Date Not Defined"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("T2:T" & last_row)

Range("U2").Select 'Overdue (Aging)
    ActiveCell.FormulaR1C1 = _
        "=INDEX('CHF Rate'!C[-18],MATCH('Parked Report'!RC[-14],'CHF Rate'!C[-20],0))*'Parked Report'!RC[-15]"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("U2:U" & last_row)

Range("V2").Select 'USD
ActiveCell.FormulaR1C1 = "=RC[-1]/'CHF Rate'!R2C4"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("V2:V" & last_row)

Range("W2").Select ' Scan Date (Aging)
ActiveCell.FormulaR1C1 = _
        "=IFERROR(IF(TodaysDate-'Parked Report'!RC[-3]<=Settings!R6C29,Settings!R6C30,IF(AND(TodaysDate-'Parked Report'!RC[-3]>=Settings!R7C29,TodaysDate-'Parked Report'!RC[-3]<Settings!R8C29),Settings!R7C30,IF(AND(TodaysDate-'Parked Report'!RC[-3]>=Settings!R8C29,TodaysDate-'Parked Report'!RC[-3]<Settings!R9C29),Settings!R8C30,IF(TodaysDate-'Parked Report'!RC[-3]>=Settings!" & _
        "R9C29,Settings!R9C30,Settings!R10C30)))),""Scan Date Not Defined"")" & _
        ""
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("W2:W" & last_row)

Range("X2").Select 'Status
    ActiveCell.FormulaR1C1 = "=IF(RC[-13]<=0,""Not Due Yet"",""Overdue"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("X2:X" & last_row)

Range("Y2").Select ' Overdue (Aging)
    ActiveCell.FormulaR1C1 = _
        "=IF(AND(RC[-10]>=Settings!R6C31,RC[-10]<Settings!R7C31),Settings!R6C32,IF(AND(RC[-10]>=Settings!R7C31,RC[-10]<Settings!R8C31),Settings!R7C32,IF(AND(RC[-10]>=Settings!R8C31,RC[-10]<Settings!R9C31),Settings!R8C32,Settings!R9C32)))"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("Y2:Y" & last_row)

Range("Z2").Select 'Critical /Non Critica
    ActiveCell.FormulaR1C1 = _
        "=IFERROR(INDEX('Critical Vendor List'!C[-22],MATCH('Parked Report'!RC[-23],'Critical Vendor List'!C[-24],0)),""Non Critical"")"
        last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row ' Fill down formula
        Selection.AutoFill Destination:=Range("Z2:Z" & last_row)

***********************************************************************
bunch of other code
***********************************************************************
Application.DisplayAlerts = True
Application.CutCopyMode = True 'Clearing the Office Clipboard
Application.ScreenUpdating = True    ' This turns the screen updating off while the macro runs, helps with speed
Application.EnableEvents = True      ' turn on
ActiveSheet.DisplayPageBreaks = False ' Disables page breaks as we wont be printing any data
Application.CutCopyMode = False ' Clear the memory


The worksheet has 1530 lines going from A-AE.

It may not be possible, but is there any way to streamline, improve speed on this section, re-write it in some way ? Its not slow slow, but still a bit slow.

thanks for your help / advice.

David
 
Last edited by a moderator:

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,303
Office Version
  1. 2010
Platform
  1. Windows
i would be recoding to allow vba to do the searching etc. those sorts of cell formulae are very cpu intensive
 

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
78
Hi yes thats whats happening, the program goes really fast, then slows right down at this point, Im not sure how to allow VBA to do the searching, all these formulas are excel formulas then pasted into the VBA code
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
HI
Why you keep calculating last_row for each formula
Put the
VBA Code:
last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).row
at the top of your code and then use last_row as much as you need
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,303
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

dave, if you are able to put the workbook up via dropbox, i may be able to rework parts of it with you
 

mohadin

Well-known Member
Joined
Mar 22, 2015
Messages
1,091
Office Version
  1. 2013
Platform
  1. Windows
What about
VBA Code:
 Sheets("Parked Report").Range("N1:AR1") = _
    Array("Vendor Name", "Days Overdue", "Assigned To", "Agent Email", _
          "User Company", "Region", "Scan Date", "Invoice Amount", "USD", "Scan Date (Aging)", _
          "Status", "Overdue (Aging)", "Critical /Non Critical", "Query User", "Comment Date", _
          "Standard Comment", "Open Comment", "Status 2", "Type Of Contact")

    last_row = ActiveSheet.Cells(Rows.Count, "c").End(xlUp).Row
    Range("N2:N" & last_row).FormulaArray = _
    "=IFERROR(INDEX(Parked!C[-10],MATCH(1,('Parked Report'!RC[-13]=Parked!C[-13])*('Parked Report'!RC[-11]=Parked!C[-11])*('Parked Report'!RC[-10]=Parked!C[-9]),0)),""Vendor Not Defined"")"
    Range("O2:O" & Cells(Rows.Count, "c").End(xlUp).Row).Formula = "=IF(K2<0,-K2,K2)"

    Range("P2:P" & last_row).FormulaArray = _
    "=IFERROR(INDEX(Parked!C[-8],MATCH(1,('Parked Report'!RC[-15]=Parked!C[-15])*('Parked Report'!RC[-13]=Parked!C[-13])*('Parked Report'!RC[-11]=Parked!C[-14]),0)),""Agent not Defined"")"

    Range("Q2:Q" & last_row).FormulaR1C1 = _
    "=IFERROR(INDEX('User List'!C[-13],MATCH('Parked Report'!RC[-1],'User List'!C[-15],0)),""Agent Email Not Defined"")"

    Range("R2:R" & last_row).FormulaR1C1 = _
    "=IFERROR(INDEX('User List'!C[-15],MATCH('Parked Report'!RC[-1],'User List'!C[-14],0)),""Agent Company Not Assigned"")"

    Range("S2:S" & last_row).FormulaR1C1 = _
    "=IF(OR(LEFT(RC[-18],2)=""US"",LEFT(RC[-18],2)=""CA"",LEFT(RC[-18],2)=""CR""),""NOAM"",""EMEA"")"

    Range("T2:T" & last_row).FormulaArray = _
    "=IFERROR(INDEX(SQ00QR_Query!C[-3],MATCH(1,('Parked Report'!RC[-19]=SQ00QR_Query!C[-18])*('Parked Report'!RC[-17]=SQ00QR_Query!C[-19])*('Parked Report'!RC[-16]=SQ00QR_Query!C[-17]),0)),""Scan Date Not Defined"")"

    Range("U2:U" & last_row).FormulaR1C1 = _
    "=INDEX('CHF Rate'!C[-18],MATCH('Parked Report'!RC[-14],'CHF Rate'!C[-20],0))*'Parked Report'!RC[-15]"

    Range("V2:V" & last_row).FormulaR1C1 = "=RC[-1]/'CHF Rate'!R2C4"

    Range("W2:W" & last_row).FormulaR1C1 = _
    "=IFERROR(IF(TodaysDate-'Parked Report'!RC[-3]<=Settings!R6C29,Settings!R6C30,IF(AND(TodaysDate-'Parked Report'!RC[-3]>=Settings!R7C29,TodaysDate-'Parked Report'!RC[-3]<Settings!R8C29),Settings!R7C30,IF(AND(TodaysDate-'Parked Report'!RC[-3]>=Settings!R8C29,TodaysDate-'Parked Report'!RC[-3]<Settings!R9C29),Settings!R8C30,IF(TodaysDate-'Parked Report'!RC[-3]>=Settings!" & _
                                           "R9C29,Settings!R9C30,Settings!R10C30)))),""Scan Date Not Defined"")" & _
                                           ""

    Range("X2:X" & last_row).FormulaR1C1 = "=IF(RC[-13]<=0,""Not Due Yet"",""Overdue"")"

    Range("Y2:Y" & last_row).FormulaR1C1 = _
    "=IF(AND(RC[-10]>=Settings!R6C31,RC[-10]<Settings!R7C31),Settings!R6C32,IF(AND(RC[-10]>=Settings!R7C31,RC[-10]<Settings!R8C31),Settings!R7C32,IF(AND(RC[-10]>=Settings!R8C31,RC[-10]<Settings!R9C31),Settings!R8C32,Settings!R9C32)))"

    Range("Z2:Z" & last_row).FormulaR1C1 = _
    "=IFERROR(INDEX('Critical Vendor List'!C[-22],MATCH('Parked Report'!RC[-23],'Critical Vendor List'!C[-24],0)),""Non Critical"")"

    '***********************************************************************
    'bunch of other code
    '***********************************************************************
    Application.DisplayAlerts = True
    Application.CutCopyMode = True    'Clearing the Office Clipboard
    Application.ScreenUpdating = True    ' This turns the screen updating off while the macro runs, helps with speed
    Application.EnableEvents = True    ' turn on
    ActiveSheet.DisplayPageBreaks = False    ' Disables page breaks as we wont be printing any data
    Application.CutCopyMode = False    ' Clear the memory
 
Solution

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
78

ADVERTISEMENT

That would be brilliant, to be honest its patch coding, source the coding from the internet, and make it work from me. This is a template of source code for other projects and is an international template when its released, its got my name all over it so if Its got issue Ive got an International incident on my hands. lol, The program is quite big, and interlinks with other spreadsheets to import the data,

Why you keep calculating last_row for each formula - I just used this so it would fill down the formulas

First downloads from SAP, as excel, imports that data, and does its magic. One of the most annoying things is getting excel extra windows to auto close except the main macro, got it working but its just annoying.

heres the link to the folder with all the files in,



To test fully youll need to block out the SAP download looks like this - theres 4 of them procedures, youll also need to install the directory and files on C: but theres an install button for that. if you want i could just strip out the code you would like, but it was easier uploading the lot. Let me know if you get issues with the link.


Sheets(Array("Parked Report", "SQ00QR_Query", "Parked")).Select
Sheets("Parked").Activate
ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = False
If Not IsObject(SAPGuiApp) Then

Set SapGuiAuto = GetObject("SAPGUI")
Set SAPGuiApp = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(Connection) Then
Set Connection = SAPGuiApp.Children(0)
End If
If Not IsObject(session) Then
Set session = Connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject SAPGuiApp, "on"
End If

''************************************************************************************************
''Section 1.0 - Download Reports from SAP - Parked Withought PO, Parked with No PO, Data Workflow
''************************************************************************************************
'
Dim xlApp As Object ' Get Data Parked Accrual without PO
Application.GoTo Reference:="CompanyCodes"
Selection.Copy

session.findById("wnd[0]").resizeWorkingPane 183, 32, False
session.findById("wnd[0]/tbar[0]/okcd").Text = "ZFI_ACCU_PD"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/subPARAM_SUB_SCREEN:ZFI_ACCRUAL_REPORT:0100/btn%_R_BUKRS_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[24]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press

Application.GoTo Reference:="PeriodDates"
Selection.Copy

session.findById("wnd[0]/usr/subPARAM_SUB_SCREEN:ZFI_ACCRUAL_REPORT:0100/btn%_R_BLDAT_%_APP_%-VALU_PUSH").press
session.findById("wnd[1]/tbar[0]/btn[24]").press
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]/usr/subPARAM_SUB_SCREEN:ZFI_ACCRUAL_REPORT:0100/ctxtV_LAYOUT").Text = "/OE3"
session.findById("wnd[0]/usr/subPARAM_SUB_SCREEN:ZFI_ACCRUAL_REPORT:0100/ctxtV_LAYOUT").SetFocus
session.findById("wnd[0]/usr/subPARAM_SUB_SCREEN:ZFI_ACCRUAL_REPORT:0100/ctxtV_LAYOUT").caretPosition = 9
session.findById("wnd[0]/tbar[1]/btn[8]").press
session.findById("wnd[0]/usr/shell").pressToolbarContextButton "&MB_EXPORT"
session.findById("wnd[0]/usr/shell").selectContextMenuItem "&XXL"
session.findById("wnd[1]/usr/cmbG_LISTBOX").SetFocus
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ctxtDY_PATH").Text = "C:\Pager Reporting\Pager Source Files\"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").Text = "1.P1NoPo.XLSX"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").caretPosition = 8
session.findById("wnd[1]/tbar[0]/btn[11]").press
session.findById("wnd[0]/tbar[0]/okcd").Text = "/n"
session.findById("wnd[0]").sendVKey 0


thanks for your help, I got it working as acceptable, but Im sure it has so many inefficiency in it, although the formulas speeding up will do.

Dave.
 

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
78
thanks for the reply, ill let you review my last message, and see what you think.
 

diddi

Well-known Member
Joined
May 20, 2004
Messages
3,303
Office Version
  1. 2010
Platform
  1. Windows
i will take a look over the next day or so and get back. i have one other member i need to finish with first, which is nearly done. another one with heaps of lookups that have been replaced :)
 

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
78
thanks, I know when its like, you build a little macro for your works, and the suddenly you start rewriting and automating whole company procedures, this one has been a steep learning cure for sure, build one then suddenly everyone wants, this just happens its going to be used in every country we operate in, so no pressure there then. sometime I wake up and say, OMG how did I get to this point lol

thanks your help will be absolutely invulnerable., giving how many different things it does, its also going to be a goto for source code.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,102
Messages
5,640,119
Members
417,126
Latest member
Jeffman52

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
Top