Using VBA to search and match two parameters to pull a value
I am doing a project that requires searching through a very large list of sales, meaning that it is a large dataset and time is something we are trying cut down on. The dataset essentially contains three pieces of information: The type of object purchased, the date is was purchased, and the amount. For simplification, I’m going to dumb down the examples below.
In addition to this dataset, we have a tab created for each of the types of objects with each date of the year running down the left hand side. The end goal of the project is to populate the purchase information onto each of these tabs so that we can do further, non-excel based, analysis.
The purchases look like the following. In real data, there are thousands of lines of purchase and a dozen or so types (Contained in a table called “Purchases”).
Product_Type Purchase_Date Amount ------------ ------------- ------ Prod A 1/1/2016 15 Prod A 1/3/2016 10 Prod A 1/8/2016 5 Prod A 1/10/2016 15 Prod A 1/15/2016 25 Prod B 1/5/2016 25 Prod B 1/7/2016 25 Prod B 1/10/2016 25 Prod B 1/13/2016 25
The resultant tab will look as follows:
Product Type: Prod A (In it's own hard-coded cell, let's say A1) Date Purchases 1/1/2016 15 1/2/2016 0 1/3/2016 10 1/4/2016 0 1/5/2016 0 1/6/2016 0 1/7/2016 0 1/8/2016 5 ... (fills out entire year)
The number in the purchase column is what we WANT to go there. The dates are also being populated when the tabs are created, so we can’t necessarily use a SUMIF hardcoded in there.
Currently, we are doing it in a very roundabout way that takes a long time: This is contained within a much larger script and it does this for each tab.
Set InfoDataRange = Range("Purchases[Product_Type]:Purchases[Amount]") FirstDate = DateAdd("yyyy", -1, Sheets("Control Log").Range("D6").Value) --populates 1/1 LastDate = Sheets("Control Log").Range("D6").Value -- populates 12/31 Rownum = 2 Do FirstDate = FirstDate + 1 Cells(Rownum, 1) = FirstDate For Each InfoDataRow In InfoDataRange If InfoDataRow.Cells(1, 1) = Range("A1") And _ 'Matching product InfoDataRow.Cells(1, 2) = FirstDate Then 'Matching date Cells(Rownum, 2) = InfoDataRow.Cells(1, 3) End If Next Rownum = Rownum + 1 Loop Until FirstDate = LastDate
I’m not necessarily looking for someone to do it for me, but am very open to any ideas to make the search go much faster.
One Solution collect form web for “Using VBA to search and match two parameters to pull a value”
My first observation is that you are searching in a loop for a more or less known quantity, i.e. the date. If you have 10,000 items in your sold items list, you are going to execute that search 10,000 times for each item, and each search looks in 366 rows. Not very efficient.
Some things you could do:
The first, and simplest, is to add “exit for” in the if statement, so that at least once you find the date, you can stop looking. That should cut the time in half, on average.
The second would be to replace your if then loop with a find function, which I’m pretty sure would be faster.
If you want to get really fancy, you could convert the date to a Julian date, and use that to access the row directly.
The best thing though, because access the sheet in code is time consuming, is to create an array to start with, and then do all your comparisons and incrementing in memory, then write the array back to the sheet.
Depending on the number of codes, you could create a 3D array and do them all in one pass.
You might also consider using a dictionary, with the date as the key, but since I haven’t tried that myself, you’ll have to decide if that’s the way to go.