by Rde (54 Submissions)
Category: String Manipulation
Difficulty: Intermediate
Date Added: Wed 3rd February 2021
Rating: 
(3 Votes)
This is an improvement on the MultiInStr function that appears in other peoples code now and again ... I don't know who the original author was, so I hope who-ever you are you don't mind ... The original code would search through a string looking for occurences of single characters, while this pair of functions search for single-or-multi character terms within the given string ... Included are MultiInStr and MultiInStrR functions ... Hope someone finds them useful ... Update 25 May - improved versions added thanks to contributions from Kenneth Buckmaster ... Update 7 Nov - Reset string len bug fix in Ken's MultiInStr ... Happy coding
VBcoders
'---------------------------------
' Simple MultiInStr:
' Always returns 'their' before 'heir'
' but returns either 'the' or 'their' depending on
' which term was found first in sTerms array order
Function MultiInStr(sSrc As String, sTerms() As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lRightLimit As Long = -1, _
Optional ByRef lHitItemIndex As Long) As Long
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
If lRightLimit = -1 Then lRightLimit = Len(sSrc)
iHit = Len(sSrc) + 1
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
If iPos Then
If iPos < iHit Then iHit = iPos: lHitItemIndex = iIdx
End If
Next
If iHit < Len(sSrc) + 1 Then MultiInStr = iHit
End Function
'---------------------------------
' Comment From: Kenneth Buckmaster
' It occurred to me that you could avoid searching the
' whole string length after a term is found
' Also added something you might want in these functions -
' returns 'the' before 'their' when in the same location
Private Declare Sub CopyMemory Lib
"kernel32" Alias "RtlMoveMemory" _
(pDest
As Any, pSrc As Any, ByVal lLenB As Long)
Function MultiInStr(sSrc As String, sTerms() As String, _
Optional ByVal lStart As Long = 1, _
Optional ByVal eCompare As VbCompareMethod = vbBinaryCompare, _
Optional ByVal lRightLimit As Long = -1, _
Optional ByRef lHitItemIndex As Long) As Long ' Kenneth Buckmaster
Dim iPos As Long
Dim iHit As Long
Dim iIdx As Long
Dim spointer As Long
Dim slenb As Long
Dim biggestlen As Long
Dim newsearchlen As Long
Dim bHit As Boolean
slenb = LenB(sSrc)
spointer = StrPtr(sSrc) - 4&
For iIdx = LBound(sTerms) To UBound(sTerms)
If LenB(sTerms(iIdx)) > biggestlen Then biggestlen = LenB(sTerms(iIdx))
Next
If lRightLimit = -1 Then lRightLimit = Len(sSrc)
iHit = Len(sSrc) + 1
For iIdx = LBound(sTerms) To UBound(sTerms)
iPos = InStr(lStart, sSrc, sTerms(iIdx), eCompare)
If iPos Then
If iPos < iHit Then
bHit = True
ElseIf iPos =