Getting Rid of .Find in VBA Code

Question

I have a range of two columns that I want to search for a "key" and then find the corresponding value in the directly adjacent column. The key is stored in a dictionary that I populated earlier in the program. I then store the value with its corresponding key in the dictionary to display later.

I am using .Find to search the range for the key and then getting the value using .Offset to get the adjacent cell. The code follows:

Dim key As Variant
Dim filRange As Range
Dim found As Range
Set filRange = ws.Range("D2:E36419").SpecialCells(xlCellTypeVisible)
 
Dim count As Integer
Dim i As Long
 
For i = 0 To partsDict.count - 1
 key = partsDict.Keys(i)
 Set found = filRange.Find(key)
 If Not found Is Nothing Then
 count = found.Offset(0, 1).value
 partsDict(i) = count
 Else
 partsDict(i) = Empty
 End If
Next i

The code functions as expected and I am able to print all values later in the program. The issue is the program takes over 15 seconds to run. I've seen the .Find method is slow and feel like there is a better way to search and retrieve my values. Should I store the range in an array somehow? Use another dictionary? Thanks!

• konijn: Cant you create a named table for the D:E entries and then search on the named table? This should reduce the search to actually used cells instead of 72k cells.
• capnation: Yes, I should have mentioned. I filtered the table before the loop and the range being searched is just the visible cells after the filtering. In the current iteration there are ~16,500 cells in the range.

Answer 1

Two things will speed up this:

• read the sheet data into an internal array and work on that
• use an auxiliary dict for searching

like this

Sub list2dict()
 ' 2020年07月02日
 
 Dim key As Variant
 Dim ws As Worksheet
 
 Dim NewpartsDict As Dictionary
 Set NewpartsDict = New Dictionary
 
 ' Set ws = ...
 
 ' read range data into array
 ' SpecialCells... might contain several areas!
 Dim myData
 Dim partrange As Range
 
 For Each partrange In ws.Range("D2:E36419").SpecialCells(xlCellTypeVisible).Areas
 myData = partrange
 ' store array data into auxiliary dict
 Dim i As Long
 For i = 1 To UBound(myData, 1)
 NewpartsDict(myData(i, 1)) = myData(i, 2) ' dict(key) = value
 Next i
 Next partrange
 ' update partsDict's existing entries
 For Each key In partsDict
 If NewpartsDict.Exists(key) Then ' a.k.a. Find()
 partsDict(key) = NewpartsDict(key)
 Else
 partsDict(key) = Empty
 End If
 Next key
 
 ' optional: add new entries
 For Each key In NewpartsDict
 If Not partsDict.Exists(key) Then
 partsDict(key) = NewpartsDict(key)
 End If
 Next key
 
 ' now use the updated data in partsDict
 End Sub

• capnation: This looks like something I could use. However, I am getting a type mismatch error in the first for-loop using UBound. Any thoughts about that?
• TinMan: he OP is working with filtered data which will often consist of noncontinuous ranges. The Range that is return bySpecialCells(xlCellTypeVisible) consists of 1 Area for each continuous set of cells. In you example, myData is only referring to the values of the first area of the target range. In order for an array based approach to work, you will need to iterate over each area of the target range.
• user1016274: yes, of course. I will work on that, it's not complicated.
• user1016274: I've added a loop over all .areas of the visible range, as suggested by @TinMan (thanks!).
• capnation: @user1016274 I am having some trouble with updating the partsDict's existing entries. Newpartsdict populates fine and has all elements in it. However, after updating partsDict, less than 10 keys have values mapped to them. Weird issue.

Answer 2

Set filRange = ws.Range("D2:E36419").SpecialCells(xlCellTypeVisible)

Hard coding range references will makes your code unnecessarily inflexible. It is best to create a dynamic range reference that will resize itself to fit the data.

With ws
 Set filRange = .Range("D2:E" & .Rows.Count).End(xlUp)
End With

The filRange is set to 2 columns. I am assuming that column 1 is the key column and column 2 is the value column. If this is the case then you should either adjust your fill range:

With ws
 Set filRange = .Range("D2" & Cells(.Rows.Count, "D").End(xlUp))
End With

Or adjust your search:

Set found = filRange.Columns(1).Find(key)

Range.CurrentRegion is a convenient way to create a dynamic range.

Set filRange = ws.CurrentRegion.Columns("D")

Question:

Do we think putting every pair in a new Dictionary structure would work? I'm thinking once everything is in the Dictionary, searching for my keys should be quick (does Dictionary use hashing?).

Answer:

Yes and yes. Dictionaries use hashing for super fast look ups. You may find this article interesting EXCEL VLOOKUP VS INDEX MATCH VS SQL VS VBA.

The reason that we use dictionaries in the first place is for the super fast look ups. The problem in your project setup is that you are using Range.Find() for your lookups. Its hard to give advice about what is the best approach with just a small snippet of code. Proving a more detailed question with all your relevant code, data samples, and perhaps a test stub will give you the best results.

Solution

Whatever you decide to do the key is to loop over the range values once and use the dictionary lookup up the values. Personally, I would write a function that returns a dictionary that holds the filtered keys and values and compare it to partsDict.

Function GetFilteredRangeMap(Target As Range, KeyColumn As Variant, ValueColumnOffset As Variant) As Scripting.Dictionary
 
 Dim Column As Range
 
 Rem Set Column to the Visible Cells in the Key Column Range
 With Target.CurrentRegion.Columns(KeyColumn)
 On Error Resume Next
 Set Column = .SpecialCells(xlCellTypeVisible)
 On Error GoTo 0
 End With
 
 If Not Column Is Nothing Then
 Dim Map As New Scripting.Dictionary
 Dim Cell As Range
 For Each Cell In Column
 Map(KeyPrefix & Cell.Value) = Cell.Offset(ValueColumnOffset)
 Next
 End If
 
 Set GetFilteredRangeMap = Map
End Function

Usage

Dim Target As Range
Set Target = Sheet2.Range("A1").CurrentRegion
Dim Map As New Scripting.Dictionary
Set Map = GetFilteredRangeMap(Target, 1, 2)

• capnation: GetFilteredRangeMap() did the trick! Thanks!
• TinMan: Thanks for accepting my answer.

Answer 3

The most probable culprit for your performance issues are the constant context switches betwwe vba and Excel whenever you call find. Depending on the number of keys in your dictionary, this can add up.

One thing you could try is to load the entire filRange into a 2d array via the range's Value property. Then you could search that. Unfortunately, there is no built-in support for that. You could sort the array and then use a binary search for every key.

One other thing I observed in your code is that you access the dictionary in a way it really is not built for. A dictionary is built to be accessed by key.

The first thing you can do is to use a For Each loop on partsDict.Keys, i.e. For Each key in partsDict.Keys. Then, when you assign the values, you can do it by key, i.e. partsDict(key) = whatever or partsDict.Item(key), which is what the first one complies to.

• capnation: Do we think putting every pair in a new Dictionary structure would work? I'm thinking once everything is in the Dictionary, searching for my keys should be quick (does Dictionary use hashing?).