-1
\$\begingroup\$

I would like that this code would now be done in a faster way:

Sub TechMapping()

    Set mappingWB = Workbooks.Open(Filename:="path\workbook1.xlsx")
    Sheets("Sheet1").Activate
    Dim Lookup_Range As Range
    Set Lookup_Range = Range("A2:P1779")

    Workbooks("workbook2.xlsb").Activate
    Set sh = ActiveSheet

    Dim i As Long   
    i = 2
    Do While i <= LastRow

        Set appid = sh.Range("A" & i)
        Set appnonapp = sh.Range("B" & i)
        Set customercountry = sh.Range("G" & i)
        Set lastactuals = sh.Range("P" & i)
        Set lasttotal = sh.Range("O" & i)

        If appnonapp.Value = "condition1" And customercountry.Value = "country1" Then

            Dim DStest As Variant
            DStest = Application.VLookup(appid, Lookup_Range, 7, False)

            If IsError(DStest) Then

                i = i + 1
                GoTo Line1

            Else

                Dim totalDS As Integer
                totalDS = Application.WorksheetFunction.VLookup(appid, Lookup_Range, 6, False)

                Dim columnnr As Integer
                columnnr = 7

                If totalDS = 1 Then

                    appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)

                Else

                    appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)
                    appid.Offset(columnoffset:=15) = lastactuals / totalDS
                    appid.Offset(columnoffset:=14) = lasttotal / totalDS

                    For j = 1 To totalDS - 1

                        Dim newcolumn As Integer
                        newcolumn = 7 + 2 * j 

                        sh.Rows(i).Copy
                        sh.Rows(i).Offset(j).Insert Shift:=xlDown
                        appid.Offset(j, 16) = Application.VLookup(appid, Lookup_Range, newcolumn, False)
                        LastRow = LastRow + 1

                    Next j

                    Application.CutCopyMode = False

                End If

            End If

    ElseIf appnonapp.Value = "condition1" And customercountry.Value <> "country1" Then ' Step 9

            appid.Offset(columnoffset:=16) = "option 1"

        ElseIf appnonapp.Value = "condition2" And customercountry.Value <> "country1" Then ' Step 10

            appid.Offset(columnoffset:=16) = "option 2"

        ElseIf appnonapp.Value <> "condition2" And appnonapp.Value <> "condition1" And customercountry.Value <> "country1" Then ' Step 11

            appid.Offset(columnoffset:=16) = "option 3"

        Else

        End If

        i = i + totalDS

    Line1:
    Loop

From what i have realized, i believe it's possible to store all values i want to insert in a temporary variable and then insert them all at once instead of doing the insert at every single row iteration. This would considerably reduce the execution time for this code.

\$\endgroup\$
  • 2
    \$\begingroup\$ @pacmaninbw This is asking for advice of a specific refactoring which is on-topic here. It is essentially "How can I refactor this code to make it faster?" \$\endgroup\$ – Simon Forsberg Mar 28 '17 at 12:43
  • \$\begingroup\$ @πάνταῥεῖ See above comment. \$\endgroup\$ – Simon Forsberg Mar 28 '17 at 12:43
  • \$\begingroup\$ @SimonForsberg OK, I see. May be should be edited to sound less about not yet written code. \$\endgroup\$ – πάντα ῥεῖ Mar 28 '17 at 12:44
  • 1
    \$\begingroup\$ So that we don't have to reverse-engineer the code, could you summarize what "this code" achieves? We can't see your worksheets, so some examples would be helpful too. See How to Ask. \$\endgroup\$ – 200_success Mar 28 '17 at 13:57
1
\$\begingroup\$

You can do something like this:

Range("A1:D1") = Array("One", "Two", "Three", "Four")

If that's what you're referring to.

Also using .Activate, ActiveSheet and .Select are bad practice. Use instead With Statements.

\$\endgroup\$
1
\$\begingroup\$
GoTo Line1

I saw that and scrolled up, thinking I had missed a line label somewhere. Line1 is a terrible name for a line label, especially in a language that supports numbered lines. That's not "line 1" at all.

Had that instruction read like this:

GoTo NextRow

I would have known right away that I was looking at the single legit use of GoTo in VBA - that GoTo jump essentially means Continue, a keyword that doesn't exist in VBA.


Your variable names are distractingly inconsistent:

mappingWB       ' camelCase, with an abbreviation
Lookup_Range    ' PascalCase, with underscores
sh              ' disemvoweled lowercase
customercountry ' all-lowercase

Pick a style, stick to it. I'd recommend using PascalCase (no underscores) for public members, and camelCase (no disemvoweling, no abbreviations, no underscores) for locals and parameters.

Avoid the underscore in identifiers. An underscore has enough meanings as it is in VBA:

  • When preceded with a space, it's a line continuation token
  • When part of a member name, it's in the form of ObjectName_MemberName for event handlers and interface implementations.

Note that a public member with an underscore in its name cannot legally be part of an implementable interface - so there's a real reason well beyond "just style" for avoiding underscores in member names.


You're not declaring all your variables, and you rely on implicit calls to default members - this will end up biting you in the rear end.

Put this at the top of every single module:

Option Explicit

And then declare your variables, until VBA can compile your code. Without this, VBA will happily compile code that contains typos, allocating on-the-fly Variant memory space for whatever comes along; this rarely results in code working as it should, and makes code excruciatingly hard to debug - for no reason at all.


You Set these undeclared locals (assuming they're locals):

    Set appid = sh.Range("A" & i)
    Set appnonapp = sh.Range("B" & i)
    Set customercountry = sh.Range("G" & i)
    Set lastactuals = sh.Range("P" & i)
    Set lasttotal = sh.Range("O" & i)

This makes them Variant/Range object references... but you use them as Range objects or as Double values indiscriminately:

    appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)
    appid.Offset(columnoffset:=15) = lastactuals / totalDS
    appid.Offset(columnoffset:=14) = lasttotal / totalDS

Left-hand side has appid treated as a Range reference, right-hand side has appid, lastactuals and lasttotal treated as a Double value. And since appid, lastactuals and lasttotal aren't declared, every single call is a late-bound IDispatch interface query. Compare to:

Dim appIdRange As Range
Set appIdRange = sh.Range("A" & i)

Dim appId As Double
appId = appIdRange.Value

This is somewhat explicit code. Notice something? The .Value variant is being coerced into a Double - if the VBA runtime can't do it (e.g. cell contains an error, or a string that can't be implicitly converted to a double), you get a run-time error. This can easily be avoided:

Dim appIdRange As Range
Set appIdRange = sh.Range("A" & i)

If IsError(appIdRange.Value) Then GoTo NextLine

Dim appId As Double
appId = appIdRange.Value

Now, we don't like GoTo jumps - they make the code jump up and down and quickly turn everything into a mess. One way to avoid that is to extract a method out of the loop body.

Do While i <= LastRow
    ProcessRow sh, i, lookupRange ', ...
Loop

And now this ProcessRow procedure can use the much cleaner Exit Sub instruction to walk back up to the calling code after validating its arguments, effectively skipping a loop iteration - only, ProcessRow doesn't even know (or care) about a loop: it's only ever concerned about a single row.


Performance-wise, your code is slow for a number of reasons:

  • Late-bound IDispatch interface queries off Variant/Range object references are much slower than early-bound Range member calls.
  • Working with ranges and calculating offsets is inherently slow.
  • Inserting rows via the clipboard is slow, especially with Application.ScreenUpdating left enabled, Application.Calculation mode left on automatic, and Application.EnableEvents firing workbook and worksheet events everytime the slightest thing changes on any cell.

From what I have realized, I believe it's possible to store all values I want to insert in a temporary variable and then insert them all at once instead of doing the insert at every single row iteration. This would considerably reduce the execution time for this code.

Absolutely. Go ahead, do it! Work with arrays instead of ranges, only ever access the worksheet when you have to, and your code will run much faster.

Also, you're doing redundant lookups:

Dim DStest As Variant
DStest = Application.VLookup(appid, Lookup_Range, 7, False)

At every single value of i, you have the lookup value at the 7th column (whatever that is - consider declaring local Const values to replace these magic numbers), stored in DStest.

But then you do this:

    Dim columnnr As Integer
    columnnr = 7

    If totalDS = 1 Then

        appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)

    Else

columnnr can only ever be 7 here, which makes that lookup entirely redundant - you're going to get the exact same value you already have in DStest.

But it gets worse - you have the same redundant lookup in the Else block too, and then you have that hard-coded 7 here again, in that inner j loop:

    Else

        appid.Offset(columnoffset:=16) = Application.VLookup(appid, Lookup_Range, columnnr, False)
        appid.Offset(columnoffset:=15) = lastactuals / totalDS
        appid.Offset(columnoffset:=14) = lasttotal / totalDS

        For j = 1 To totalDS - 1

            Dim newcolumn As Integer
            newcolumn = 7 + 2 * j 

            sh.Rows(i).Copy
            sh.Rows(i).Offset(j).Insert Shift:=xlDown
            appid.Offset(j, 16) = Application.VLookup(appid, Lookup_Range, newcolumn, False)
            LastRow = LastRow + 1

        Next j

Should that 7 ever need to turn into a 8, you've almost guaranteed a bug here. This entire block of code should be inside its own scope.

These Offset ranges make things much more confusing than they need to be - and these late-bound lookups are going to be slow.


If it wasn't of the IsError check at the beginning of the loop, this one would throw a run-time error:

Dim totalDS As Integer
totalDS = Application.WorksheetFunction.VLookup(appid, Lookup_Range, 6, False)

WorksheetFunction.VLookup is an early-bound call, and if that lookup fails you'll get a VBA run-time error - as opposed to Application.VLookup, which returns an error value, à la Excel 95. But there's another problem: you're narrowing the result into a 16-bit integer, but if the cell contains a numeric value, it would be a Double, not an Integer: there's a risk of an overflow here, should the lookup ever yield a value greater than 32,767. Regardless of the "possible values" here, the code shouldn't have to care about them - it's reading a Double and implicitly forcing it into an Integer: it spells trouble, and there's no reason for it. Best declare totalDS As Double and rule out that possibility.


The indentation is confused and confusing. Consider using an indenter tool like Rubberduck (disclaimer: I'm heavily involved in that open-source project) to do it for you. As a bonus you'll get code inspections, that will tell you many other things about your code - including things that I missed in my review, for example the fact that j isn't declared, or that mappingWB is never used anywhere.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.