• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 4069
  • Last Modified:

VBA finding a term in an two dimensional array

Hello,

The code below works I just need to speed it up.  My function checks to see if a given term is in the second dimension of an array.  If so it returns the index of the term, if not it returns 0.  Sometimes there are over 300 terms, so this can get pretty slow.  How can I speed up the code?  This is in VBA

Thanks
Function FindTermInArray(TheArray As Variant, searchTerm As String)
Dim i As Integer
FindTermInArray = 0
For i = 0 To UBound(TheArray, 2)
    
    If Trim(TheArray(0, i)) = Trim(searchTerm) Then
        FindTermInArray = i
    End If
    
Next i

End Function

Open in new window

0
eshurak
Asked:
eshurak
  • 3
  • 2
  • 2
  • +2
3 Solutions
 
DanMerkCommented:
You can add an EXIT FOR if you find a term (i.e. place 'EXIT FOR' after line 7). This way, if you find the term before the end of the list, your sub will exit. On average, this should cut your sub's performance time in half. This way your function will find the first occurrence of the term.
0
 
GMGeniusCommented:
1. Longs are faster than Integers in VB6 code (.NET Integer is better)
2. In your For loop you could change to the below so that once its found it will drop out of the loop.
3. Create a variable to hold an already Trimmed version, you are performing a Trim on every test
4. Change your function to return a data type
    Function FindTermInArray(TheArray As Variant, searchTerm As String) as Long (or integer)

    If Trim(TheArray(0, i)) = Trim(searchTerm) Then
        FindTermInArray = i
        Exit For
    End If

Open in new window

0
 
PandaPantsCommented:
In addition to the points above, you'll gain a slight improvement in performance by Trim-ing your searchTerm once, instead of re-running the Trim function with each iteration:

Function FindTermInArray(TheArray As Variant, searchTerm As String)
Dim i As Integer
dim TrimmedSearchTerm as string
TrimmedSearchTerm = Trim(searchTerm)
FindTermInArray = 0
For i = 0 To UBound(TheArray, 2)
   
   If Trim(TheArray(0, i)) = TrimmedSearchTerm Then
        FindTermInArray = i
        Exit For
    End If    
Next i

End Function

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
GMGeniusCommented:
I had already pointed the Trim out in my point 3 :-)
0
 
PandaPantsCommented:
GMGenius: Sorry, I overlooked that in your point 3.

Here's a different approach, which may or may not be faster for arrays of the size with which you deal. It's an attempt to take advantage of the Filter function, which returns an array of matching (or nonmatching) terms from a one-dimensional array. Since your source array is two-dimensional, we'll first create a 1-D array from the second parameter of the source, then filter that. If the filter returns an empty array, there's no match and the function returns False; if the filter returns a non-empty array, then at least one match was found and the function returns True.

I wasn't sure whether you really needed the index of the matching term from the original array, so I didn't capture it. However, I wrote the code so that the index is appended to the end of the value in the 1-D array (and in the array returned by the filter), so you can extract it if needed.

Again, I'm not sure you'll see a performance gain in the range of values you're looking at, but Filter is much faster than an interative comparison. I'm gambling that it's quicker to copy values from one (2-D) array to another (1-D) without evaluating the contents and then to filter the result, than it would be to evaluate each term in order. (Obviously, if you found a match in the first couple terms, then an iterative comparison would be quicker, but the point is that we don't know that going in.)

Anyway, this may be a waste of both our time, but here it is. Good luck.
Public Function ValueIsInArray(ByVal pvSourceArray As Variant, ByVal psSearchTerm As String) As Boolean
    ' Boolean function returns True if value is in array; else returns False
    ' The idea is to Filter the source array, but the Filter function only works on one-dimensional arrays.
    ' Therefore, we create a one-dimensional array of the values from the second parameter of the source array, and Filter that.
    ' In case you need to find the index of the matching value in the original array, we'll append that index to the end of the value _
        in the one-dimensional array.
    ' Finally, we'll Filter the one-dimensional array for the search term; _
        an empty array means no match, while any other result indicates at least one match was found.
        
    Dim lgUBoundSource As Long, lgUBoundResult As Long, lgCtr As Long
    Dim sTrimmedSearchTerm As String, sValueForNewArray As String
    Dim sarrResultFromFilter As String ' This will be a one-dimensional, zero-based array of strings containing matches
    
    ' Get upper dimension of source array:
    lgUBoundSource = UBound(pvSourceArray, 2)
    
    ' Define one-dimensional array to hold second parameter(s) of source array
    Dim sNewArray(0 To lgUBoundSource) As String
    
    For lgCtr = 0 To lgUBoundSource
        ' Store Trimmed second parameter(s) of source array to new array, _
                appending an underscore character and an index value in case you need that index later:
        sNewArray(lgCtr) = Trim(pvSourceArray(0, lgCtr)) & "_" & str(lgCtr)
    Next lgCtr

    ' Trim the search term, then append an underscore to ensure the filtered result will return only exact text matches:
    sTrimmedSearchTerm = Trim(psSearchTerm) & "_"
    
    ' Filter the one-dimensional array; result will be an array of matching terms (or an empty array if no matches):
    sarrResultFromFilter = Filter(sNewArray, sTrimmedSearchTerm, True)
    lgUBoundResult = UBound(sarrResultFromFilter)
    If lgUBoundResult >= 0 Then
        ' Got at least one result; ' index of term in original array is = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
        ValueIsInArray = True
    Else
        ' Got no results
        ValueIsInArray = False
    End If
    
End Function

Open in new window

0
 
eshurakAuthor Commented:
PandaPants - Unfortunately using filter is giving bad results.  It will return that SearchTerm "Securities" is a match for "Equity Securities"  in other words it will give a partial match so even if it's faster it's no good.
0
 
Brian WithunCommented:
It this array of terms is used over and over again it would be beneficial to sort it once, then you could search through it much more quickly.

On average, searching 300 items would find a match after 150 iterations.

If it were sorted you could find your match in 9 tries or fewer.

It's only faster if you search the same data set over and over again.  The initial sorting would be relatively expensive.
0
 
PandaPantsCommented:
Re: Bad results for partial match. You're right, I'm sorry I overlooked the possibility of a match on the last word of an otherwise distinct phrase. Easily fixed, though, by prefixing the search term with a unique character string:

Public Function ValueIsInArray(ByVal pvSourceArray As Variant, ByVal psSearchTerm As String) As Boolean
    ' Boolean function returns True if value is in array; else returns False
    ' The idea is to Filter the source array, but the Filter function only works on one-dimensional arrays.
    ' Therefore, we create a one-dimensional array of the values from the second parameter of the source array, and Filter that.
    ' In case you need to find the index of the matching value in the original array, we'll append that index to the end of the value _
        in the one-dimensional array. ALSO, PREFIX THE SEARCH TERM TO AVOID PARTIAL MATCHES.
    ' Finally, we'll Filter the one-dimensional array for the search term; _
        an empty array means no match, while any other result indicates at least one match was found.
        
    Dim lgUBoundSource As Long, lgUBoundResult As Long, lgCtr As Long
    Dim sTrimmedSearchTerm As String, sValueForNewArray As String
    Dim sarrResultFromFilter As String ' This will be a one-dimensional, zero-based array of strings containing matches
    
    ' Get upper dimension of source array:
    lgUBoundSource = UBound(pvSourceArray, 2)
    
    ' Define one-dimensional array to hold second parameter(s) of source array
    Dim sNewArray(0 To lgUBoundSource) As String
    
    For lgCtr = 0 To lgUBoundSource
        ' Store Trimmed second parameter(s) of source array to new array, _
                appending an underscore character and an index value in case you need that index later (ALSO PREPEND A UNIQUE STRING TO AVOID PARTIAL MATCHES):
        sNewArray(lgCtr) = "&&&" & Trim(pvSourceArray(0, lgCtr)) & "_" & str(lgCtr)
    Next lgCtr

    ' Trim the search term, then append an underscore to ensure the filtered result will return only exact text matches (ALSO PREPEND THE UNIQUE STRING):
    sTrimmedSearchTerm = "&&&" & Trim(psSearchTerm) & "_"
    
    ' Filter the one-dimensional array; result will be an array of matching terms (or an empty array if no matches):
    sarrResultFromFilter = Filter(sNewArray, sTrimmedSearchTerm, True)
    lgUBoundResult = UBound(sarrResultFromFilter)
    If lgUBoundResult >= 0 Then
        ' Got at least one result; ' index of term in original array is = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
        ValueIsInArray = True
    Else
        ' Got no results
        ValueIsInArray = False
    End If
    
End Function

Open in new window

0
 
eshurakAuthor Commented:
Thanks everyone for your help.  I'm using parts of all suggestions in other sections of my code.

Panda, adding the "&&&" works.  I've made some other minor changes to your code as I was getting some errors.

Private Function ValueIsInArray(ByVal pvSourceArray As Variant, ByVal psSearchTerm As String) As Long
'
'NOT IN USE
'

    ' Boolean function returns True if value is in array; else returns False
    ' The idea is to Filter the source array, but the Filter function only works on one-dimensional arrays.
    ' Therefore, we create a one-dimensional array of the values from the second parameter of the source array, and Filter that.
    ' In case you need to find the index of the matching value in the original array, we'll append that index to the end of the value _
        in the one-dimensional array.
    ' Finally, we'll Filter the one-dimensional array for the search term; _
        an empty array means no match, while any other result indicates at least one match was found.
        
    Dim lgUBoundSource As Long, lgUBoundResult As Long, lgCtr As Long
    Dim sTrimmedSearchTerm As String, sValueForNewArray As String
    Dim sarrResultFromFilter() As String ' This will be a one-dimensional, zero-based array of strings containing matches
    
    ' Get upper dimension of source array:
    lgUBoundSource = UBound(pvSourceArray, 2)
    
    ' Define one-dimensional array to hold second parameter(s) of source array
    Dim sNewArray() As String
    ReDim sNewArray(lgUBoundSource)
    For lgCtr = 0 To lgUBoundSource
        ' Store Trimmed second parameter(s) of source array to new array, _
                appending an underscore character and an index value in case you need that index later:
        sNewArray(lgCtr) = "&&&" & Trim(pvSourceArray(0, lgCtr)) & "_" & Str(lgCtr)
    Next lgCtr

    ' Trim the search term, then append an underscore to ensure the filtered result will return only exact text matches:
    sTrimmedSearchTerm = "&&&" & Trim(psSearchTerm) & "_"
    
    ' Filter the one-dimensional array; result will be an array of matching terms (or an empty array if no matches):
    sarrResultFromFilter = Filter(sNewArray, sTrimmedSearchTerm, True, vbTextCompare)
    lgUBoundResult = UBound(sarrResultFromFilter)
    If lgUBoundResult >= 0 Then
        ' Got at least one result; ' index of term in original array is = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
        ValueIsInArray = CLng(Mid(sarrResultFromFilter(0), Len(sTrimmedSearchTerm) + 1))
    Else
        ' Got no results
        ValueIsInArray = 0
    End If
    
End Function

Open in new window

0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

  • 3
  • 2
  • 2
  • +2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now