Alter code to find exact or nearest match to work on string left of first comma

[capson]

Hello

I got this from Here
[h=2]vba code to find exact or nearest match and return that match in new column[/h]
It works very well, but I need for it to match only on the full name e.g

txt string = Bob Boberson, Ph.d , XYZ

r in rng = Bob Boberson, LLC

To match only on "Bob Boberson" i.e to match only on Full Names sans titles otherwise matching can be off

I tried but beyond me

Thank you for any help on this

[COLOR=blue]Function[/COLOR] VLookLike(txt [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR], rng [COLOR=blue]As[/COLOR] Range) [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR] 
    [COLOR=blue]Dim[/COLOR] temp [COLOR=blue]As[/COLOR] [COLOR=blue]String[/COLOR], e, n [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], a() 
    Static RegX [COLOR=blue]As[/COLOR] [COLOR=blue]Object[/COLOR] 
    [COLOR=blue]If[/COLOR] RegX [COLOR=blue]Is[/COLOR] [COLOR=blue]Nothing[/COLOR] [COLOR=blue]Then[/COLOR] 
        [COLOR=blue]Set[/COLOR] RegX = CreateObject("VBScript.RegExp") 
        [COLOR=blue]With[/COLOR] RegX 
            .Global = [COLOR=blue]True[/COLOR] 
            .IgnoreCase = [COLOR=blue]True[/COLOR] 
            .Pattern = "(\S+).*" & Chr(2) & ".*\1" 
        [COLOR=blue]End With[/COLOR] 
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
    [COLOR=blue]With[/COLOR] RegX 
        [COLOR=blue]For Each[/COLOR] e [COLOR=blue]In[/COLOR] rng.Value 
            [COLOR=blue]If[/COLOR] UCase$(e) = UCase(txt) [COLOR=blue]Then[/COLOR] 
                VLookLike = e 
                Exit [COLOR=blue]For[/COLOR] 
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
            temp = Join$(Array(e, txt), Chr(2)) 
            [COLOR=blue]If[/COLOR] .test(temp) [COLOR=blue]Then[/COLOR] 
                n = n + 1 
                [COLOR=blue]Redim[/COLOR] [COLOR=blue]Preserve[/COLOR] a(1 [COLOR=blue]To[/COLOR] 2, 1 [COLOR=blue]To[/COLOR] n) 
                a(2, n) = e 
                [COLOR=blue]Do[/COLOR] [COLOR=blue]While[/COLOR] .test(temp) 
                    a(1, n) = a(1, n) + Len(.Execute(temp)(0).submatches(0)) 
                    temp = Replace(temp, .Execute(temp)(0).submatches(0), "") 
                [COLOR=blue]Loop[/COLOR] 
            [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
        [COLOR=blue]Next[/COLOR] 
    [COLOR=blue]End With[/COLOR] 
    [COLOR=blue]If[/COLOR] (VLookLike = "") * (n > 0) [COLOR=blue]Then[/COLOR] 
        [COLOR=blue]With[/COLOR] Application 
            VLookLike = .HLookup(.Max(.Index(a, 1, 0)), a, 2, [COLOR=blue]False[/COLOR]) 
        [COLOR=blue]End With[/COLOR] 
    [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR] 
[COLOR=blue]End Function[/COLOR]

 

[capson]

I got it

I use this to get everything to the left of the ", "

Function splitCell(strValue As String, delim As String) As String
   
   If strValue <> "" Then
     splitCell = Split(strValue, delim)(0)
   Else
     strValue = ""
   End If
   
End Function

I changed this

[COLOR=blue]If[/COLOR][COLOR=#333333] UCase$(e) = UCase(txt)[/COLOR]

to this

If UCase$(splitCell(CStr(e), ", ")) = UCase(splitCell(txt, ", "))

and I get a much better match on Full Names

 

[mart37]

You have found already a solution.

I have maybe found a pattern: """[^""]*""|[^,]*"

 

[capson]

Thank you mart37, I will give it a try