Multiple Search with Array function in excel - runs very slow

[RodP]

Hi Everyone,

I've put together a function in excel that will provide multiple search results from an array and can be based on multiple search criteria. Plus you can return a value that is offset to the location the value in question was found.

However it works rather slowly and so would be grateful if any of you could look through the function and suggest what code could be changed to make it more efficient. I'm self taught and so the way I've written it is the way I know but am very welcome to further improve my VBA writing skills.

Many thanks in advance

RodP

ps. some of the lines wrapped round to the next one, hope this doesn't confuse anyone. I'm using excel 2000.

Function MultipleSearch(ByVal strSearchFor, ByVal Target As Variant, ByVal Row_Offset As Integer, ByVal Column_Offset As Integer) As String
Dim OneCell As Range

Application.Calculation = xlCalculateManual


MultipleSearch = ""

'check if there is more than one item to search for in the strsearchFor cell (separated by a chr(10) / character return)

If InStr(1, strSearchFor, Chr(10), vbTextCompare) > 0 Then
    GoTo strSearchForArrayInCell
    Else
    GoTo strSearchForNormal
End If
GoTo endfunction

    
strSearchForArrayInCell:
arrSplit = Split(strSearchFor, Chr(10), -1, 1)
For Each strsplit In arrSplit
    foundit = False
    If TypeName(Target) = "Range" Then
        
        For Each OneCell In Target
            
            If InStr(1, OneCell.Text, strsplit, vbTextCompare) > 0 Then
            foundit = True
                 
            If MultipleSearch = "" Then
            MultipleSearch = strsplit & "= TRUE"
            Else
            MultipleSearch = MultipleSearch & Chr(10) & strsplit & "= TRUE"
            End If
            
            End If
        Next OneCell
        If foundit = False Then 'ie report individual lines could not be found
            If MultipleSearch = "" Then
            MultipleSearch = strsplit & "= FALSE"
            Else
            MultipleSearch = MultipleSearch & Chr(10) & strsplit & "= FALSE"
            End If
        End If
    'ElseIf TypeName(Target) = "String" Then
    '  If InStr(1, Target, strSearchFor, vbTextCompare) > 0 Then MultipleSearch = strSearchFor
    End If
    
    'MsgBox (MultipleSearch)
Next strsplit
GoTo endfunction


strSearchForNormal:

foundit = False

If TypeName(Target) = "Range" Then
    For Each OneCell In Target
      If InStr(1, OneCell.Text, strSearchFor, vbTextCompare) > 0 Then
        'MultipleSearch = strSearchFor
         foundit = True
         If MultipleSearch = "" Then
         MultipleSearch = OneCell.Offset(Row_Offset, Column_Offset).Value
         Else
         MultipleSearch = MultipleSearch & Chr(10) & OneCell.Offset(Row_Offset, Column_Offset).Value
         End If
        'Exit For
      End If
    Next OneCell
     
    If foundit = False Then
        If MultipleSearch = "" Then
        MultipleSearch = "Not found"
        Else
        MultipleSearch = MultipleSearch & Chr(10) & "Not found"
        End If
    End If
   
Else
    
    If TypeName(Target) = "String" Then
        If InStr(1, Target, strSearchFor, vbTextCompare) > 0 Then
        foundit = True
        MultipleSearch = strSearchFor
        End If
    
        If foundit = False Then
            If MultipleSearch = "" Then
            MultipleSearch = "Not found"
            Else
            MultipleSearch = MultipleSearch & Chr(10) & "Not found"
            End If
        End If
    End If
   
End If
   
    

endfunction:

Application.Calculation = xlCalculationAutomatic

  
End Function

 

[xlbo]

Seems like you are looping through cells looking for values - any reason you can't use the FIND method using the lookat:= xlpart argument ?

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[RodP]

Hi xlbo,

The function will look for multiple instance. It works a bit like a vlookup forumla but returns the offset value of more than one instance. Really good to find whether an item in some data exists in say more than one category.

eg.

Item1 Category1
Item2 Category1
Item3 Category1
Item1 Category2

the function (if offset = 0,1) would return in the cell..

Category1
Category2

Hope this explains the purpose of the function.

Cheers

RodP

 

[xlbo]

question still remains - that can be done with FIND/FINDNEXT - there is a very good example in the help files for finding multiple instances of data....

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[RodP]

Hi Xlbo,

Thanks for the tip and I presume that using 'find' will speed things up. I've found the example in the help but am having problems. I think it's due to my lack of understanding of objects. Can you help?

This is my code which doesn't want to work / just returns zero in the cell where I've written =test2()

Function test2()

With Range("rng2") 'simply cells A1:A10 with the number 2 in one or two cells

    Set c = .Find(2, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            test2 = c.Address
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With

End Function

 

[xlbo]

Apologies - din't realise this needed to go in a sheet - there are some issues with using the FINDNEXT method within a function called from a worksheet - it will find the 1st instance but bombs out on the FindNext call.

See if this can be made to work for you:

Function test2()
Dim c As Range
With Range("A1:A10") 'simply cells A1:A10 with the number 2 in one or two cells

    Set c = .Find(2, LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            If test2 = "" Then
                test2 = c.Address
            Else
                test2 = test2 & ", " & c.Address
            End If
            
            Set c = .Find(c, Range(c.Address), xlValues)
                    
                    Loop While Not c Is Nothing And InStr(1, test2, c.Address) = 0
        
    End If
End With

End Function

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[RodP]

Hi Xlbo,

Unfortunately, your version doesn't work either. 'c' remains to be nothing after the '.find...' bit.

Any suggesitons - or should I go back to using the 'instr' method - any suggestions on speeding that up?

Many thanks

RodP

 

[xlbo]

Hmmm - did a test on a sheet I set up with a couple of 2s in cells A1:A10

entered =test2() in a cell and it retuend both addresses seperated by a comma...

Have amended slightly - this definitely works with 2s in various cells in A1:A10

Function test2()
Dim c As Range
With Range("A1:A10") 'simply cells A1:A10 with the number 2 in one or two cells

    Set c = .Find(2, .Cells(.Cells.Count, 1), LookIn:=xlValues)
    If Not c Is Nothing Then
        Do
            If test2 = "" Then
                test2 = c.Address
            Else
                test2 = test2 & ", " & c.Address
            End If
            
            Set c = .Find(c, Range(c.Address), xlValues)
                    
                    Loop While Not c Is Nothing And InStr(1, test2, c.Address) = 0
        
    End If
End With

End Function

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[RodP]

Hi Xlbo

This is very interesting. I'm using excel 2000. Are you perhaps using a newer version? I tried your latest code but it still returns 0 in the cell. 'c' is still nothing. I'm putting the code into a normal module within the same workbook to test it.

Any ideas?

Thanks

RodP

 

[xlbo]

I am on xl2003 - works fine on that. If FIND won't work in the function on the spreadsheet, you will either have to continue to loop through all the cells (which will be what causes the length of time to complete) OR you can look at running some code from a sub that does the find and simply enters the values in the appropriate place on the sheet - that would depend on how the function is entered and how the results need to be displayed however. If the entry that should return the result will always be in a specific column or there is some logic that can be applied then this should not be too hard...

Rgds, Geoff

We could learn a lot from crayons. Some are sharp, some are pretty and some are dull. Some have weird names and all are different colours but they all live in the same box.

Please read FAQ222-2244 before you ask a question

 

[RodP]

Hi Xlbo,

Thanks for the note and I've now found some other info...

http://www.ozgrid.com/forum/showthread.php?t=26905

It looks like maybe in 2003 it's been sorted but a way to get round it is as you suggest run the .find procedure from a sub. I'll have a go at moving at setting up a funciton which calls a sub and let you know how I get on.

Thanks

RodP