Match partial word instead of all or nothing

Hi there! I was looking at what is now a closed thread here, and found this lovely bit of code. The only problem I've been having with it is that it changes the font of only an exact word but if the word is part of another word the macro won't touch it. Eg if a cell contains "I have a cat" it will change to "I have a cat" but if the cell contains "I have cats" it will remain "I have cats". How would you modify this code so that the word's font will change even if it is contained within another word: "I have cats"

Option Explicit
Option Compare Text

Sub test()
    Dim myList, myColor, myPtn As String, r As Range, m As Object, x
    Columns(1).Font.ColorIndex = xlAutomatic
    myList = VBA.Array("Cat", "Mouse")  '<-- add more if needed
    myColor = VBA.Array(vbRed, vbBlue)  '<-- adjust as per myList(use Color value, not ColorIndex)
    myPtn = Join$(myList, Chr(2))
    With CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = True
        .Pattern = "([\^\$\(\)\[\]\*\+\-\?\.\|])"
        myPtn = Replace(.Replace(myPtn, "\$1"), Chr(2), "|")
        .Pattern = "\b(" & myPtn & ")\b"
        For Each r In Range("a1", Range("a" & Rows.Count).End(xlUp))
            If .test(r.Value) Then
                For Each m In .Execute(r.Value)
                    x = Application.Match(m, myList)
                    If Not IsError(x) Then
                        r.Characters(m.firstindex + 1, m.Length).Font.Color = myColor(x - 1)
                    End If
                Next
            End If
        Next
    End With
End Sub

I tried modifying a bunch of stuff on line:

.Pattern = "\b(" & myPtn & ")\b"

but nothing seemed to work. Any help would be greatly appreciated!