Largest part of code VB formulas speed issues

D

Dave01

Board Regular
Joined
Nov 30, 2018
Messages
116
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
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

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
i would be recoding to allow vba to do the searching etc. those sorts of cell formulae are very cpu intensive
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
dave, if you are able to put the workbook up via dropbox, i may be able to rework parts of it with you
 
Upvote 0
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
 
Upvote 0
Solution
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,

Dropbox

www.dropbox.com www.dropbox.com


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.
 
Upvote 0
thanks for the reply, ill let you review my last message, and see what you think.
 
Upvote 0
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 :)
 
Upvote 0
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.
 
Upvote 0
You must log in or register to reply here.

Similar threads

Sean15
  • Question Question
Could you help improve recorded macro
2
Replies
13
Views
412
Sean15
Sean15
T
  • Question Question
ActiveSheet. Paste error
Replies
1
Views
335
RoryA
RoryA
P
  • Question Question
Help with Vba Code
Replies
3
Views
433
Coyotex3
C
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
239
rlv01
R
J
  • Solved
VBA Code Error Unable to get the Match property of the WorksheetFunction class
Replies
8
Views
173
Jiraya_00
J

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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