Solved

VBA finding a term in an two dimensional array

Posted on 2010-09-07
9
3,367 Views
Last Modified: 2013-11-25
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
Comment
Question by:eshurak
  • 3
  • 2
  • 2
  • +2
9 Comments
 
LVL 3

Assisted Solution

by:DanMerk
DanMerk earned 25 total points
ID: 33621210
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
 
LVL 12

Assisted Solution

by:GMGenius
GMGenius earned 75 total points
ID: 33621231
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
 
LVL 8

Expert Comment

by:PandaPants
ID: 33621521
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
 
LVL 12

Expert Comment

by:GMGenius
ID: 33621703
I had already pointed the Trim out in my point 3 :-)
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 8

Expert Comment

by:PandaPants
ID: 33622401
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
 
LVL 3

Author Comment

by:eshurak
ID: 33623078
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
 
LVL 13

Expert Comment

by:Brian Withun
ID: 33625915
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
 
LVL 8

Accepted Solution

by:
PandaPants earned 400 total points
ID: 33628234
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
 
LVL 3

Author Comment

by:eshurak
ID: 33639233
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction This tutorial provides instructions on how to properly format your Word document using the inbuilt tools provided. The benefits of using these tools means your documents are more accessible and easily portable to other applications an…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now