Edit VBA to scan a document and pick out the reference numeral that corresponds to a string, e.g. output "102" for "dog 102" in the document

Question

My current code to do this works when all instances of the string in the document are accompanied by the associated numeral. However, where some instances of "dog" arent followed by "102", but some are, the code fails to return "102", i.e. doesn't pick up the reference numeral, instead concluding that no numeral can be found. Here is my code:

Sub FindRefNumeral()
Dim targetString As String
Dim foundRange As Range
Dim numeral As String

' Get user input
targetString = InputBox("Feature:")

' Search the document
Set foundRange = ActiveDocument.Content
With foundRange.Find
    .text = targetString & " [0-9]{1,3}" & "[A-Za-z]*"
    .MatchWildcards = True
    If .Execute Then
        ' Extract the numeral
        numeral = Split(foundRange.text, " ")(UBound(Split(foundRange.text, " ")))
        MsgBox "Reference numeral: " & numeral
    Else
        MsgBox "No reference numeral found."
    End If
End With
End Sub

I want the macro to scan the document for any instances of that string (i.e., "dog") associated with a reference numeral, and outputs in a text box the reference numeral associated with the string, i.e., "102". I also want the macro to be robust to erroneous numerals in the document, i.e. if both "dog 102" and "dog 103" are present, I'd like the macro to output the numeral that most commonly follows the string - since this is probably the correct one.

(Only if no numeral is associated with that string, i.e., no instances of the requested string are found preceding a reference numeral, do I want the output text box to display "no numeral".)

This seems like it should be an easy fix, presumably involving looping through all instances of the string in the document, functionality which the code doesn't have yet. Any ideas?

Answer 1

I guess the problem is the "[A-Za-z]*"-part of your search term. The find implementation of word is not using regular expressions, and [A-Za-z]* will not look for on look for zero or one character, but for exactly one. Therefore, dog 123a will be found, while dog 456 will not.

I have rewritten your routine to a function for testing:

Function FindRefNumeral(range As range, targetstring As String) As String
    With range.Find
        .Text = targetstring & " [0-9]{1;3}" & "[A-Za-z]*"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        Dim okay As Boolean
        okay = .Execute
        If okay Then
            Dim tokens() As String
            tokens = Split(range.Text, " ")
            FindRefNumeral = tokens(UBound(tokens))
        End If
    End With
End Function

My test routine looked like this:

Sub test()
    Debug.Print FindRefNumeral(ActiveDocument.Content, "dog")
    Debug.Print FindRefNumeral(ActiveDocument.Content, "cat")
End Sub

And I was using the wonderful text

Header
No dog and no cat
Hello dog 999 how are you?
My cat 23a is great
Some more data, another cat and a tiny dog.

The result was

dog: 
cat: 23a

So the number for dog was not found.

Now I don't know if there is any clever way in Word to look for zero or one character - using {0,1} failed ("Invalid search term"). So I decided to first look for a number with character, and if this fails, look for a number "without" character:

Function FindRefNumeral(range As range, targetstring As String) As String
    With range.Find
        .Text = targetstring & " [0-9]{1;3}" & "[A-Za-z]*"
        .MatchWildcards = True
        .Wrap = wdFindContinue
        Dim okay As Boolean
        okay = .Execute
        If Not okay Then
            .Text = targetstring & " [0-9]{1;3}"
            okay = .Execute
        End If
        If okay Then
            Dim tokens() As String
            tokens = Split(range.Text, " ")
            FindRefNumeral = tokens(UBound(tokens))
        End If
    End With
End Function

And now the result is as expected:

dog: 999
cat: 23a

Update Your wish for a Sub is pretty easy, just ask the user for the input string, call the function and dump the result.

Sub AskAndFindRefNumeral()
    ' Get user input
    Dim targetString As String
    targetString = InputBox("Feature:")
    If targetString = "" Then Exit Sub

    ' Call function to find the text
    Dim textFound As String
    textFound = FindRefNumeral(ActiveDocument.Content, targetString)

    ' Tell it to the user
    if textFound = "" Then
        MsgBox "No reference numeral found."
    Else
        MsgBox "Reference numeral: " & textFound 
    End If
End Sub