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!

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. — konijn
– konijn, Commented Jul 1, 2020 at 18:58
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. — capnation
– capnation, Commented Jul 1, 2020 at 19:09

user1016274 · Accepted Answer · 2020-07-03 14:32:20Z

2

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

edited Jul 3, 2020 at 14:32

answered Jul 2, 2020 at 12:57

user1016274

6445 silver badges9 bronze badges

\$\begingroup\$ 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? \$\endgroup\$

capnation
– capnation

2020-07-02 15:52:10 +00:00
Commented Jul 2, 2020 at 15:52
1

\$\begingroup\$ 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. \$\endgroup\$

TinMan
– TinMan

2020-07-03 00:50:50 +00:00
Commented Jul 3, 2020 at 0:50
\$\begingroup\$ yes, of course. I will work on that, it's not complicated. \$\endgroup\$

user1016274
– user1016274

2020-07-03 13:45:56 +00:00
Commented Jul 3, 2020 at 13:45
1

\$\begingroup\$ I've added a loop over all .areas of the visible range, as suggested by @TinMan (thanks!). \$\endgroup\$

user1016274
– user1016274

2020-07-03 14:33:23 +00:00
Commented Jul 3, 2020 at 14:33
\$\begingroup\$ @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. \$\endgroup\$

capnation
– capnation

2020-07-07 13:51:31 +00:00
Commented Jul 7, 2020 at 13:51

| Show 4 more comments

TinMan · Accepted Answer · 2020-07-02 11:02:50Z

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)

\$\begingroup\$ GetFilteredRangeMap() did the trick! Thanks! \$\endgroup\$

capnation
– capnation

2020-07-02 12:27:24 +00:00
Commented Jul 2, 2020 at 12:27 — capnation
– capnation, Commented Jul 2, 2020 at 12:27
\$\begingroup\$ Thanks for accepting my answer. \$\endgroup\$

TinMan
– TinMan

2020-07-03 00:51:12 +00:00
Commented Jul 3, 2020 at 0:51 — TinMan
– TinMan, Commented Jul 3, 2020 at 0:51

M.Doerner · Accepted Answer · 2020-07-01 20:40:18Z

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.

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?). — capnation
– capnation, Commented Jul 1, 2020 at 23:40

Stack Exchange Network

Getting Rid of .Find in VBA Code

3 Answers 3

Question:

Answer:

Solution

Usage

You must log in to answer this question.

Hot Network Questions

Getting Rid of .Find in VBA Code

3 Answers 3

Question:

Answer:

Solution

Usage

You must log in to answer this question.

Related

Hot Network Questions