0

Good morning SO community.

I'm developing a report which takes 2 existing reports and creates a third summarising and I am keen to execute the daily creation task through vba rather than manual process. It's about 100K lines with a few vlookups and a nested sumif. Where possible I've defined the last row as a variable and put that into the range for the vlookups to stop it going through all million cells and have turned of calculate, screen updating etc.

The end to end macro takes about 15 minutes to run and is producing the end results I intended. However if I step through each individual line the process takes about 3 minutes to run and the end result is the same.

Not really looking for improvement advice as it is working (although it's always welcome) but trying to understand why it is so much quicker when stepping through rather than running.

I've included the entire code below, n.b I've used my company name within a lot of the dim names I've set and in sheet and workbook names, so to protect the company it's been replaced with "XXXX"

Thanks a lot

Plan 303

Sub processdata()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim XXXXLen As Long
    With Sheets("Input - XXXXwebnew")
        XXXXLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'add concatenate ref column in column A on Input XXXXWebNew

    Sheets("INPUT - XXXXwebnew").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Sheets("INPUT - XXXXwebnew").Range("A1:A" & XXXXLen) = "=CONCATENATE(E1,""_"",G1,""_"",I1)"
    Application.Calculate
    Sheets("Input - XXXXwebnew").Range("a1:a" & XXXXLen).Copy
    Sheets("Input - XXXXwebnew").Range("a1:a" & XXXXLen).PasteSpecial xlPasteValues

    'picks up config products and moves them from E (input - XXXXwebnew) to to A on (workings) tab

    Workbooks("workingmodel.xlsm").Sheets("WORKINGS").Range("a2:a" & XXXXLen + 1).value _
        = Workbooks("workingmodel.xlsm").Sheets("INPUT - XXXXWebNew").Range("e1:e" & XXXXLen).value

    'picks up simple products and moves them from A (input - XXXXwebnew) to to A on (workings) tab

    'set a second dim which is the dim XXXXlen X2

    Dim XXXXlen2 As Long
    XXXXlen2 = XXXXLen + XXXXLen

    Workbooks("workingmodel.xlsm").Sheets("WORKINGS").Range("a" & XXXXLen + 2 & ":a" & XXXXlen2 + 1).value _
        = Workbooks("workingmodel.xlsm").Sheets("INPUT - XXXXWebNew").Range("a1:a" & XXXXLen).value

    'remove all duplicates

    Sheets("workings").Range("$A$1:$A$" & XXXXlen2 + 1).RemoveDuplicates Columns:=1, Header:=xlYes

    'dim set for Workings tab length of data

    Dim WorkLen As Long
    With Sheets("WORKINGS")
        WorkLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'brings first formula in, calculates, C&Psp

    Sheets("workings").Range("b2:b" & WorkLen) = "=IF(LEN(A2)=12,""CONFIG"",""SIMPLE"")"
    Application.Calculate
    Sheets("workings").Range("b2:b" & WorkLen).Copy
    Sheets("workings").Range("b2:b" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("c1") = "does it appear within XXXX_all(code means yes / #N/A means no)"

    'define lenght of XXXX_all
    Dim XXXXallLen As Long
    With Sheets("INPUT - XXXX_all")
        XXXXallLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'building the various dimensions required for a dynamic vba vlookup

    Dim sheetXXXX_all As String
    sheetXXXX_all = "INPUT - XXXX_all"

    Dim XXXXalllookup As String
    XXXXalllookup = ("'" & sheetXXXX_all & "'!$A$1:$m$" & XXXXallLen)

    Sheets("workings").Range("c2:c" & WorkLen) = "=left(VLOOKUP(A2," & XXXXalllookup & ",1,FALSE),12)"
    Application.Calculate
    Sheets("workings").Range("c2:c" & WorkLen).Copy
    Sheets("workings").Range("c2:c" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("d1") = "is it enabled"


    Sheets("workings").Range("d2:d" & WorkLen) = "=VLOOKUP(A2," & XXXXalllookup & ",2,FALSE)"
    Application.Calculate
    Sheets("workings").Range("d2:d" & WorkLen).Copy
    Sheets("workings").Range("d2:d" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("e1") = "does it have an image 0 = no #N/A = product code doesn't exist"

    Sheets("workings").Range("e2:e" & WorkLen) = "=VLOOKUP(A2," & XXXXalllookup & ",4,FALSE)"
    Application.Calculate
    Sheets("workings").Range("e2:e" & WorkLen).Copy
    Sheets("workings").Range("e2:e" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("f1") = "does description has a character"

    Sheets("workings").Range("f2:f" & WorkLen) = "=IF(LEN(VLOOKUP(A2," & XXXXalllookup & ",4,FALSE))=0,""NO DESC"",""FINE"")"
    Application.Calculate
    Sheets("workings").Range("f2:f" & WorkLen).Copy
    Sheets("workings").Range("f2:f" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("g1") = "RRRP Price"

    Sheets("workings").Range("g2:g" & WorkLen) = "=IF(VLOOKUP(A2," & XXXXalllookup & ",6,FALSE)<0.1,""NO PRICE"",""PRICE EXISTS"")"
    Application.Calculate
    Sheets("workings").Range("g2:g" & WorkLen).Copy
    Sheets("workings").Range("g2:g" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("h1") = "UK Price"

    Sheets("workings").Range("h2:h" & WorkLen) = "=IF(VLOOKUP(A2," & XXXXalllookup & ",13,FALSE)<0.1,""NO PRICE"",""PRICE EXISTS"")"
    Application.Calculate
    Sheets("workings").Range("h2:h" & WorkLen).Copy
    Sheets("workings").Range("h2:h" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("I1") = "Current stock greater than 0"

    Sheets("workings").Range("i2:i" & WorkLen).FormulaR1C1 = "=IF(RC[-7]=""config"",IF(SUMIF('Input - XXXXwebnew'!C[-4],WORKINGS!RC[-8],'Input - XXXXwebnew'!C[11])<0.1,""NO STOCK"",""HAS STOCK""),IF(VLOOKUP(RC[-8],'Input - XXXXwebnew'!C[-8]:C[12],20,FALSE)>0,""HAS STOCK"",""NO STOCK""))"
    Application.Calculate
    Sheets("workings").Range("i2:i" & WorkLen).Copy
    Sheets("workings").Range("i2:i" & WorkLen).PasteSpecial xlPasteValues

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub
Pᴇʜ
  • 56,719
  • 10
  • 49
  • 73
plan303
  • 25
  • 4
  • How many rows of data are you working with? – SierraOscar Mar 23 '17 at 11:26
  • I wouldn't trust someone whose last name is a number :] Did you measure the 3 min after the 15 min and how did you measure it? It's possible that some of the results were cashed if you ran the 3 min after the 15 – Slai Mar 23 '17 at 11:36
  • Hi, 100K or so lines of data. It's big so I had an expectation that it would take a while to run. I ran it three times, using the same source data shutting excel between each run and it took about 15 minutes (using a stopwatch) each time. I then wanted to see which line was taking the bulk of the time and decided to step through manually and it took about 3 minutes to produce the same results. I agree, I wouldn't trust me either... – plan303 Mar 23 '17 at 11:39
  • 3
    Since your code *is* running codereview.stackexchange.com may be a better bet as they are thre to help with code inefficencies and the like – Mr.Burns Mar 23 '17 at 11:50
  • 1
    I think @Slai nailed it. I just restarted Excel and started a fresh but made sure not to run the macro before stepping through and it took nearer to the 15 minutes. Previous results must have been cached and created the illusion of saved time. Thanks for your comments and taking the time to read my question. – plan303 Mar 23 '17 at 11:53
  • 3
    BTW, this macro can run in few seconds if you are willing to try posting a question on http://codereview.stackexchange.com/ – Slai Mar 23 '17 at 11:58
  • Agree with @Slai - post your question on codereview and you will get a lot of good suggestions for performance enhancements. – Robin Mackenzie Mar 23 '17 at 12:01
  • 1
    @plan303 I am not an expert but I have done the odd vba script. I have found that avoiding interaction with "Select" and ".Selection" speeds up the process alot. You can easily replace these with fixed references. I would also not update a cell with a formula, I would calculate the formula within vba and then update the cell. – Stian Mar 23 '17 at 12:03
  • Will do, thanks again – plan303 Mar 23 '17 at 12:03
  • Lookups in arrays and collections are quicker than lookups in worksheets. Range to array is pretty quick as well: `Dim yourArray as Variant` then `yourArray = ThisWorkbook.Worksheet("sheetName").Range("A1:A100000")`. That's it, you have your array fresh to look for something in it! – simpLE MAn Mar 23 '17 at 12:27
  • 2
    I'm flagging this question as off-topic because it should be migrated to CodeReview as stipulated here: http://meta.stackoverflow.com/questions/266749/migration-of-code-questions-from-stack-overflow-to-code-review Reason: the code is working and the OP himself / herself asks for a way to improve upon speed. At the same time the current code is working without problems. – Ralph Mar 23 '17 at 12:28
  • HI @Ralph, I have posted it in codeReview as requested. – plan303 Mar 23 '17 at 12:41
  • 1
    @Ralph, Unless the question has been edited since your comment, the question seems to be "why is stepping through in debug quicker?", which does seem like a valid SO question to me. – SteveES Mar 23 '17 at 13:42

1 Answers1

0

I don't profess to be good in vba - others on here are! But the two links below may help you improve your code :

How to avoid using Select in Excel VBA macros

http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html

Community
  • 1
  • 1
Solar Mike
  • 7,156
  • 4
  • 17
  • 32
  • be careful of the second link "`Application.ScreenUpdating = False 'To Turn on at the end of the code.`" :] – Slai Mar 23 '17 at 19:29