Use string in column to find a word match in table to assign value

I have a lookup table of data in Sheet1 where all the names in columns A and B will be unique, so no names in either A will exist in B and vice-versa. However, some names could include special characters like a hyphen or dash such as O’neil or Jamie-lee

I have another table of data in Sheet2, in which I need to use the text string in column D to find a matching name in Sheet1 (in either column A or B) and then assign the Score value of the row on sheet1 if a match is found into Sheet2 column E.

I have entered the matched score values in column E to demonstrate the outcome I require.
I don’t mind using VBA or an Excel formula that works in XL2010

Is it possible to use a text string to find a word match, as I’ve only seen it the other way around, or am I looking at this the wrong way? I just don’t seem to be getting anywhere.

I have change the code so often now trying to get it to work, I think I’m a bit lost, but this is the current state of my code that isn’t working:

Sub TextSearch()

    Dim LR As Long
        LR = ThisWorkbook.Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    Dim xLR As Long
        xLR = ThisWorkbook.Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Row

    
    Dim oSht As Worksheet
    Dim Lastrow As Long
    Dim strSearch As String, Score As String
    Dim aCell As Range
    Dim i As Integer
    
    Set oSht = Sheets("Sheet1")
    Lastrow = oSht.Range("A" & Rows.Count).End(xlUp).Row
    
        
    With Sheets("Sheet2")
        'Loop from Lastrow to Firstrow (bottom to top)
        For Lrow = xLR To 2 Step -1
            'Get the value in the D column to perform search on
            With .Cells(Lrow, "D")
                If Not IsEmpty(.Value) Then
                    strSearch = .Value
                
                    Set aCell = oSht.Range("A1:B" & Lastrow).Find(What:=strSearch, LookIn:=xlValues, _
                                    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                    MatchCase:=False, SearchFormat:=False)

                    For i = 2 To Lastrow
                        'Lookin column A on sheet1
                        If oSht.Cells(i, 1).Value = aCell Then
                            Score = oSht.Cells(i, 1).Offset(0, 2).Value
                            Sheets("Sheet2").Cells(Lrow, 4).Offset(0, 1).Value = Score
                        'Lookin Column B on sheet1
                        ElseIf oSht.Cells(i, 2).Value = aCell Then
                            Score = oSht.Cells(i, 2).Offset(0, 1).Value
                            Sheets("Sheet2").Cells(Lrow, 4).Offset(0, 1).Value = Score
                        End If
                    Next i
                
                
                End If
            End With
        Next Lrow
    End With

End Sub

>Solution :

This should do what you are attempting using a dictionary. It creates keys based off of Columns A and B on Sheet 1 with their scores stored as the item.

If you have duplicate names in Sheet 1 this won’t fail, but it will only match against the first name encountered. There isn’t enough data for it to make a distinction that I can see.

Sub findmatches()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim dict As Object
    Dim i As Long
    Dim lr As Long
    Dim name As String
    
    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")
    Set dict = CreateObject("Scripting.Dictionary")
    
    With ws1
        lr = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lr
            If Not dict.exists(.Cells(i, 1).Value) Then
                dict.Add .Cells(i, 1).Value, .Cells(i, 3).Value
            End If
            If Not dict.exists(.Cells(i, 2).Value) Then
                dict.Add .Cells(i, 2).Value, .Cells(i, 3).Value
            End If
        Next i
    End With
    
    With ws2
        lr = .Cells(.Rows.Count, 4).End(xlUp).Row
        For i = 2 To lr
            name = Split(.Cells(i, 4).Value, " ")(0)
            If dict.exists(name) Then
                .Cells(i, 5).Value = dict(name)
            Else
                .Cells(i, 5).Value = 0
            End If
        Next i
    End With
End Sub