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
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
I’m not sure I understand why you declare
AccountNumber As Variant, and then repeatedly cast it to a
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).
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.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.
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.
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