2

I have the following function that finds words in a string, for instance searching for don will find Don and not don't which is what I want: "I don't know Don, what do you think?"

I however also find I need to look for words like race, races, racing. I would like to be able to search for rac* to cover all such variants rather than searching for each.

Is it possible to update the code to do this? Or does someone have any code that can solved this problem?

  Function InStrExact(Start As Long, SourceText As String, WordToFind As String, _
  Optional CaseSensitive As Boolean = False)

  Dim x As Long, Str1 As String, Str2 As String, Pattern As String

  If CaseSensitive Then
    Str1 = SourceText
    Str2 = WordToFind
    Pattern = "[!A-Za-z0-9]"
  Else
    Str1 = UCase(SourceText)
    Str2 = UCase(WordToFind)
    Pattern = "[!A-Z0-9]"
  End If

  For x = Start To Len(Str1) - Len(Str2) + 1
    If Mid(" " & Str1 & " ", x, Len(Str2) + 2) Like Pattern & Str2 & Pattern _
       And Not Mid(Str1, x) Like Str2 & "'[" & Mid(Pattern, 3) & "*" Then
      InStrExact = x
      Exit Function
    End If
  Next
End Function
Del
  • 131
  • 2
  • 13
  • 2
    As your pattern matching becomes more complex, you may find learning and using Regular Expressions to be a more useful and flexible tool. [How to use Regular Expressions in VBA](http://stackoverflow.com/questions/22542834/how-to-use-regular-expressions-regex-in-microsoft-excel-both-in-cell-and-loops) – Ron Rosenfeld Feb 12 '17 at 12:04
  • 2
    @Del what about *"I am Don's friend"*? Does your code match *"Don"* in this case? – A.S.H Feb 12 '17 at 13:19

2 Answers2

0

I'd go like follows:

Function InStrExact(startPos As Long, sourceText As String, wordToFind As String, _
                     Optional CaseSensitive As Boolean = False) As Long

    Dim x As Long
    Dim actualSourceText As String, actualWordToFind As String, Pattern As String
    Dim word As Variant

    actualSourceText = Replace(Mid(sourceText, startPos), ",", "")
    If CaseSensitive Then
        Pattern = "[A-za-z]"
    Else
        actualSourceText = UCase(actualSourceText)
        actualWordToFind = UCase(wordToFind)
        Pattern = "[A-Z]"
    End If

    For Each word In Split(actualSourceText, " ")
        If CStr(word) Like actualWordToFind & Pattern Or CStr(word) = actualWordToFind Then
            InStrExact2 = x + 1
            Exit Function
        End If
        x = x + Len(word) + 1
    Next
    InStrExact = -1 '<--| return -1 if no match
End Function
user3598756
  • 28,893
  • 4
  • 18
  • 28
  • Thanks for this - the wordtofind can be a phrase so this wouldn't work as it only searches for single words – Del Feb 12 '17 at 13:50
  • You didn't specify that in your question that only had examples about single words. So you may want to remove the downvote at least! – user3598756 Feb 12 '17 at 14:27
  • My mistake. I should have mentioned it in op. I didn't down vote it - not sure who did... I have added a vote. – Del Feb 12 '17 at 14:59
  • I see. Well, thanks for re-establishing _justice_. As to the brave downvoter, I'll keep waiting for him to explain its vote and have both me improve my answer and other people their knowledge. – user3598756 Feb 12 '17 at 15:02
0

A simple modification is to add a wildcard to the end of your search string and match against all remaining characters in the original string. The change is to replace this line:

If Mid(" " & Str1 & " ", x, Len(Str2) + 2) Like Pattern & Str2 & Pattern _

with this:

If Mid(" " & Str1 & " ", x) Like Pattern & Str2 & Pattern & "*" _

This simply removes the restriction on the number of characters to be matched. If a wildcard is added to the end of the search word, it comes before the trailing pattern and so allows any number of additional characters. If there is no wildcard in the search word, then the trailing pattern still needs to come immediately after the search word and hence still requires an exact match.

Note that there will be an issue if the word you're searching for is the last word AND you add a wildcard. The length of Str2 then causes the function to stop searching too soon. So the complete solution is to also replace this line:

 For x = Start To Len(Str1) - Len(Str2) + 1

with this:

 For x = Start To Len(Str1)

There's no need to stop checking any earlier.

Michael
  • 4,563
  • 2
  • 11
  • 25
  • Worked like a charm Michael - thank you! I'm not sure who's been downvoting all the answers - they all added value – Del Feb 12 '17 at 13:42