Index Match implementation

Question

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

Answer 1

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.

Answer 2

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