Find only whole word, not the part of a word from Excel Workbook

Question

I am working from MS Word to extract data from an Excel Workbook:

Sub Birthyard()
Dim xlapp As Object
Dim xlbook As Object
Dim xlsheet As Object
Dim SWORD As Range

Set SWORD = Selection.Paragraphs(1).Range
SWORD.MoveEnd wdCharacter, -1

On Error Resume Next
Set xlapp = GetObject(, "Excel.Application")

If Err Then
    bstartApp = True
    Set xlapp = CreateObject("Excel.Application")
End If

On Error GoTo 0

With xlapp
    Set xlbook = .Workbooks.Open("C:\users\ibnea\Desktop\list.xlsm")
    Set RANG = xlbook.Worksheets("Sheet4").Range("A:B").Find(SWORD)

    If RANG Is Nothing Then
        MsgBox "Nothing Found in Sheet4 Range(A:B)"
    Else
        If RANG.Column = "2" Then
        COMPANY = RANG.Offset(0, -1).Value
        TICKER = RANG.Value
        MsgBox COMPANY & TICKER
        Else
        COMPANY = RANG.Value
        TICKER = RANG.Offset(0, 1).Value
        MsgBox COMPANY & TICKER
        End If
    End If

End With

If bstartApp = True Then
    xlapp.Quit
End If

Set xlapp = Nothing
Set xlbook = Nothing
Set xlsheet = Nothing

End Sub

Above code opens an Excel Workbook and finds a given word from the first two columns. The problem lies when text found is part of a word.

For example, if the search word/criteria contains a small string such as "be" or "sp" then I get several of false results. I need the function to stop looking within the words and look at the word as a whole for a match.

I found that it will be done by adding a trim Function, and regex is a thing that does the job. I don't know how to handle these functions.

Answer 1

Find Whole Word in Cells of a Range

The search (Find) is done by rows i.e. A1, B1, A2, B2 , A3, B3... If you want it done by column, change xlByRows to xlByColumns (A1, A2, A3 ... B1, B2, B3...).

The FindWord subroutine searches each found cell containing the word (SWORD) for an occurrence of the whole word (SWORD).

The Code

Sub Birthyard()

    Dim xlapp As Object
    Dim xlbook As Object
    Dim xlsheet As Object
    Dim SWORD As Range

    Dim vntRng As Variant
    Dim intCount As Integer
    Dim blnFound As Boolean
    Dim strFirst As String

    Set SWORD = Selection.Paragraphs(1).Range
    SWORD.MoveEnd wdCharacter, -1

    On Error Resume Next
    Set xlapp = GetObject(, "Excel.Application")

    If Err Then
        bstartApp = True
        Set xlapp = CreateObject("Excel.Application")
    End If

    On Error GoTo 0

    With xlapp

        Set xlbook = .Workbooks.Open("C:\users\ibnea\Desktop\list.xlsm")

        With xlbook.Worksheets("Sheet4").Range("A:B")
            Set RANG = .Find(SWORD, .Cells(.Rows.Count, .Columns.Count), _
                    xlValues, xlPart, xlByRows)
            If Not RANG Is Nothing Then
                GoSub FindWord
                If blnFound = False Then
                    strFirst = RANG.Address
                    Do
                        Set RANG = .FindNext(RANG)
                        Debug.Print RANG.Address
                        GoSub FindWord
                    Loop While Not blnFound = True And RANG.Address <> strFirst
                End If
            End If
            If blnFound Then
                If RANG.Column = "2" Then
                COMPANY = RANG.Offset(0, -1).Value
                TICKER = RANG.Value
                MsgBox COMPANY & TICKER
                Else
                COMPANY = RANG.Value
                TICKER = RANG.Offset(0, 1).Value
                MsgBox COMPANY & TICKER
                End If
              Else
                MsgBox "Nothing Found in Sheet4 Range(A:B)"
            End If
        End With

        If bstartApp = True Then
            .Quit
        End If

    End With

    Set xlapp = Nothing
    Set xlbook = Nothing
    Set xlsheet = Nothing

Exit Sub

FindWord:
    vntRng = Split(RANG.Value)
    For intCount = 0 To UBound(vntRng)
        If vntRng(intCount) = SWORD Then Exit For
    Next
    If intCount <= UBound(vntRng) Then
        blnFound = True
    End If
    Return

End Sub

Answer 2

loop thorugh all found occurrences till you meet the one with the keyword as a single word:

here is the relevant snippet:

    With xlbook.Worksheets("Sheet4").Range("A:B")
        Set RANG = .Find(what:=SWORD, lookat:=xlPart, LookIn:=xlValues)
        If Not RANG Is Nothing Then
            Dim firstAddress As String
            firstAddress = RANG.Address
            Do
                If Not IsError(Application.Match(SWORD, Split(RANG, " "), 0)) Then
                    MsgBox "found " & SWORD & " in " & RANG.Address

                    ' do what you need with RANG object


                    Exit Do
                End If
                Set RANG = .FindNext(RANG)
            Loop While RANG.Address <> firstAddress
        End If
    End With