2
\$\begingroup\$

The code below takes header variables, retrieves the column index, and then, using an Index/Match function, returns data from a matching account number.

The reason it is written this way is because I wanted to make the code "reusable". By being able to change the hard-coded header names, I can update the Macro based on our client.

The code itself is unreasonably slow. It takes 35 secs to pull 4 accounts.

  • I'm looking to make the code more efficient.
  • Is there a different approach to making "reusable" code, which would be easier to read and look neater.

   Sub RetrieveData()

Dim Headers(1 To 21, 1 To 2)



 Headers(1, 1) = "StockNbr"
    Headers(2, 1) = "Customer Last Name"
    Headers(3, 1) = "Customer First Name"
    Headers(4, 1) = "Date Sold"
    Headers(5, 1) = "Amount Financed"
    Headers(6, 1) = "Finance Charges"
    Headers(7, 1) = ""
    Headers(8, 1) = "APR Rate"
    Headers(9, 1) = ""
    Headers(10, 1) = "Payment Amount"
    Headers(11, 1) = "Payment Schedule"
    Headers(12, 1) = "Contract Term (Month)"
    Headers(13, 1) = "Year"
    Headers(14, 1) = "Make"
    Headers(15, 1) = "Model"
    Headers(16, 1) = "VIN"
    Headers(17, 1) = "Odometer"
    Headers(18, 1) = "Principal Balance"
    Headers(19, 1) = "Cash Down"
    Headers(20, 1) = ""
    Headers(21, 1) = ""

    Dim FundingSheet As Worksheet
    Dim AccountNumber As Variant
    Dim AccountRange As Range

    Dim i As Integer
    Dim x As Integer
    Set AccountRange = Selection
    Debug.Print AccountRange.Address

    'B/c there is no naming convention, many different static data names
    Set FundingSheet = Sheets("StaticFunding")
    i = 1

    'looking for the column index and attaching to second dimension
    For i = LBound(Headers) To UBound(Headers)
        If Headers(i, 1) = "" Then
            Headers(i, 2) = ""
        Else
            Headers(i, 2) = Application.Match(Headers(i, 1), FundingSheet.Rows(3), 0)
        End If

    Next i

    'retrieving information using Index Match

    For Each Cell In AccountRange 
    AccountNumber = Cell.Value
    x = 2
    i = 1

    For i = LBound(Headers) To UBound(Headers)

        If Headers(x, 2) = "" Then
            x = x + 1
        Else
            Cell.Offset(0, x).Value = Application.index(FundingSheet.Columns(Headers(x, 2)), Application.Match(CStr(AccountNumber), FundingSheet.Columns(Headers(1, 2)), 0))
            x = x + 1
        End If

        If x = 22 Then Exit For
    Next i

    Next Cell

    End Sub
\$\endgroup\$
  • \$\begingroup\$ Honestly, this makes me wonder why you're not using named ranges, (or even data tables) and standard EXCEL formulas. Why does this need a macro? I've just skimmed the code, but this is not stuff for a macro. This is formulas and maybe a pivot table. \$\endgroup\$ – Vogel612 Sep 9 '18 at 20:53
  • \$\begingroup\$ Yes, functions would probably be better. The usage and upkeep of this workbook are very complex, multiple departments working on it, not enough updates over the years. For example, the final product cannot be the result of a function because as new data sets are introduced (and old ones removed), the data changes and we just want to capture a "snapshot". This and other examples, make it difficult to introduce new methods. \$\endgroup\$ – Nahuatl_C137 Sep 9 '18 at 22:51
4
\$\begingroup\$

If you want to make the code "easier to read and look neater", the first thing that I would do is to run it through an indenter. This is currently haphazard at best, and makes it difficult to follow.


The second thing I would do for ease of readabilty and maintenance is to extract the top portion of the Sub where you build the Headers array and calculate the column indexes into a function. This Sub is doing 2 things, and everything above 'retrieving information using Index Match can be treated as an atomic procedure.


I'd replace the string literals "" with the constant vbNullString - it's more readable and doesn't require a memory allocation. While you're at it, I'd get rid of all of the other magic numbers that you're using. For example, FundingSheet.Rows(3) would be much more readable as FundingSheet.Rows(HEADER_ROW).


I'm not sure I understand why you declare AccountNumber As Variant, and then repeatedly cast it to a String with CStr(AccountNumber). If you're using it as a String, declare it as a String. Declare it as a String and then just cast it once when you assign it:

AccountNumber = CStr(Cell.Value)

Avoid 1 based indexing like Dim Headers(1 To 21, 1 To 2) unless there is a good reason to do so. The default array base is zero, you aren't setting the Option Base, and there is nothing in the procedure where having a base of 1 is relevant. All it does is add cognative load when you've scrolled down to the bottom of the Sub and trying to process the indexing.


Regarding the comment 'B/c there is no naming convention, many different static data names, you should consider passing the sheet name to the Sub as a parameter instead of hard coding it (presumably in a copied and pasted version of the procedure). It isn't clear from your description if the same applies to the hard coded column headers, but those can also be passed as a parameter if they are not fixed (and would be another reason to extract the top portion as a function).


Performance

This code is slow because you are writing VBA code as if it were intended to be a function on a worksheet. If you need it to function independently (for example, in a UDF), that might be appropriate, but it is never going to be performant. Take a look at the top of the Sub. You're basically trying to build a lookup table, but then promptly discarding (or ignoring) the captured information later in the code and relying on Application.Index and Application.Match to get your column definitions in the correct order. This section (line break added for clarity)...

For i = LBound(Headers) To UBound(Headers)

    If Headers(x, 2) = "" Then
        x = x + 1
    Else
        Cell.Offset(0, x).Value = Application.Index(FundingSheet.Columns(Headers(x, 2)), _
            Application.Match(CStr(AccountNumber), FundingSheet.Columns(Headers(1, 2)), 0))
        x = x + 1
    End If

    If x = 22 Then Exit For
Next i

...is repeating the row lookup for every single column. That is incredibly inefficient. It might make sense if this was a UDF (and would be inefficient as a user function too), because each cell in a column would need to find the appropriate row. It's silly in this context though, because the Application.Match is going to return exactly the same thing for each of the 22 times that you call it.

For each account, you need to do two things; First, find the row that contains the account data, Second, copy the data based on the column lookup. I'd consider using a Scripting.Dictionary for the column lookup - you're doing a fairly simply column mapping between source column and destination column, so once you have the mapping built you can do lookups on that instead of repeatedly using Application.Index. Find the row target row once before you loop through the Headers array, and then just map the columns to the correct destinations. That would be a huge first step in improving the performance.


That said...

You're using Excel as if it was database. The real solution would be to use an actual database as a back-end and use Excel to simply present the data. If you can't do that for some logistical reason (IT resistance, for example), then stop treating Excel as a spreadsheet when you retrieve data from it. Open an ADO connection, and just query for your lookup results. ADO doesn't care about the column order, and you can just request columns by name and write them where they need to go. This is going to be way faster than using the Excel lookups (the driver is optimized for this), and you can request multiple results in one operation.

If Excel is your "database", then take advantage of the database tools that are available.

\$\endgroup\$
  • \$\begingroup\$ Good answer - though I'd say when it comes to excel, the spreadsheet is 1-based and so sometimes it does make sense to dimension arrays base-1, and I am vehemently against using Option Base. However, as you note, that's pretty much against general good practice for most languages. \$\endgroup\$ – Raystafarian Sep 10 '18 at 0:44
  • 1
    \$\begingroup\$ @Raystafarian - Agreed, but the main difference here is that the OP's 1 based array isn't tied directly to a Range - just some magic numbers. \$\endgroup\$ – Comintern Sep 10 '18 at 0:46
  • 1
    \$\begingroup\$ @DanielMcCracken I'd say "very strong personal preference". VBA is not Excel, so I find it much more natural to assume that Excel is serving up non-standard arrays than the other way around. \$\endgroup\$ – Comintern Sep 11 '18 at 18:47
  • 2
    \$\begingroup\$ @DanielMcCracken I actually do consider it a priority to point out to new programmers, because it helps them understand how the programming language works as opposed to how an object model works. The advice is "don't do something unexpected", which is valid in any programming language. \$\endgroup\$ – Comintern Sep 11 '18 at 19:40
  • 2
    \$\begingroup\$ @DanielMcCracken half the VBA code I write is outside of Microsoft Office. VBA has well over 200 licensed, non-Office host applications, from ERP systems to CAD and vector-drawing software. "VBA is not Excel", indeed, and 1000% percent. Understanding the language separately from one particular Microsoft object model, is fundamental. Learning and understanding "Excel ranges are 1-based" separately from "VBA arrays are N-based" is critical, especially for a new programmer. \$\endgroup\$ – Mathieu Guindon Sep 11 '18 at 19:53
2
\$\begingroup\$

Just a quick note, there's a better way to populate your array(s) -

Const HEADERS As String = "StockNbr,Customer Last Name,Customer First Name,Date Sold,Amount Financed,Finance Charges,,APR Rate,,Payment Amount,Payment Schedule,Contract Term (Month),Year,Make,Model,VIN,Odometer,Principle Balance,Cash Down,,"
Dim headerArray As Variant
headerArray = Split(HEADERS, ",")
Dim valueArray As Variant
ReDim valueArray(UBound(headerArray))
Dim index As Long
For index = LBound(valueArray) To UBound(valueArray)
    If Not headerArray(index) = "" Then valueArray(index) = 'do your stuff here
Next
\$\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.