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.
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.
Code:
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