VBA - extract last matching occurrence in string

[BenGee]

Hi

I have a list of full names (one name per cell) to compare to in column A. In column E, I have a string of varying lengths containing first names and surnames separated with a semicolon - for example "firstname1 surname1; firstname2 surname2; firstname3 surname3"

Column F contains the last firstname surname in the string in column E. What I want to do is compare the names in Column F to my range A2:A40, and where there's not a match, to extract the last matching name from the string instead.

So;
Column A contains - "Harry Potter" "Hermione Granger" "Ron Weasley" (separate cells)
Column E contains - "Harry Potter; Ron Weasley; Draco Malfoy; Albus Dumbledore" (string in one cell)
Column F contains - "Albus Dumbledore"
Column G desired result = "Ron Weasley"

I have this that only gets me the first firstname surname from the string instead, where Column F doesn't match Column A

For Each c1 In Sheets("test").Range("F2:F" & lastRow2)
    For Each c2 In Sheets("tableData").Range("A2:A40")
        If c2.Value <> c1.Value Then
            c1.Offset(, 1).Value = Split(c1.Offset(, -1).Value, ";")
        End If
    Next
Next

Any ideas please?

 

[RudRud]

Book3
	A	B	C	D	E	F	G
1	Harry Potter				Harry Potter; Ron Weasley; Draco Malfoy; Albus Dumbledore	Albus Dumbledore	Ron Weasley
2	Hermione Granger
3	Ron Weasley
Sheet1

Something like this?

Sub test2()
Dim dict As New dictionary
dict.CompareMode = vbTextCompare

a = Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
e = Split(Range("e1").Value, "; ")

For i = 1 To UBound(a, 1)
    dict.Add a(i, 1), i
Next i

For i = 0 To UBound(e, 1)
    If dict.Exists(e(i)) Then
        b = e(i)
    End If
Next i

[g1].Value = b

End Sub

What's the purpose of column F? Is it fill manually? have any other conditions?

 

[BenGee]

For i = 1 To UBound(a, 1)

Thanks RudRud - I get a type mismatch on this line?

Column F is purely to show 'output' to the user. And no other conditions and it's not manual, the full code if it helps is;

Application.ScreenUpdating = False

lastRow2 = Sheets("test").Range("E" & Rows.Count).End(xlUp).Row

Sheets("test").Range("F1:F" & lastRow2).Formula = "=TRIM(RIGHT(SUBSTITUTE(E1,"";"",REPT("" "",LEN(E1))),LEN(E1)))"

For Each c1 In Sheets("test").Range("F2:F" & lastRow2)
    For Each c2 In Sheets("tableData").Range("A2:A40")
        If c2.Value <> c1.Value Then
            c1.Offset(, 1).Value = Split(c1.Offset(, -1).Value, ";")
        End If
    Next
Next

Application.ScreenUpdating = True

 

[RudRud]

Thanks RudRud - I get a type mismatch on this line?

Hi, Would you mind either take photos of your dataset or post data through xlbb?

• Want to help your helpers by posting a small, copyable, screen shot directly in your post? XL2BB Instructions & Download (latest January 2021 v 2.0 )

 

[RudRud]

Can you see below example? is it your expecting result?

Column F : search last first & last name from column E
Column G : extract last matching name

Book1
	A	B	C	D	E	F	G
1	Harry Potter				Harry Potter; Ron Weasley; Draco Malfoy; Albus Dumbledore	Albus Dumbledore	Ron Weasley
2	Hermione Granger				Harry Potter; Draco Malfoy	Draco Malfoy	Harry Potter
3	Ron Weasley
Sheet1

Sub test2()
Dim dict As New Dictionary
dict.CompareMode = vbTextCompare

For Each ss In Range("e1:e" & Cells(Rows.Count, "e").End(xlUp).Row)
e = Split(ss.Value, "; ")
a = Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)


For i = 1 To UBound(a, 1)
    dict.Add a(i, 1), i
Next i

For i = 0 To UBound(e, 1)
    If dict.Exists(e(i)) Then
        b = e(i)
    End If
Next i

ss.Offset(0, 1).Value = Right(ss.Value, Len(ss.Value) - InStrRev(ss.Value, "; ") - 1)
ss.Offset(0, 2).Value = b
dict.RemoveAll

Next ss

End Sub

 

[RudRud]

test:

Book1
	A	B	C	D	E	F	G
1					Harry Potter; Ron Weasley; Draco Malfoy; Albus Dumbledore	Albus Dumbledore	Ron Weasley
2					Harry Potter; Draco Malfoy	Draco Malfoy	Harry Potter
test

tableData

Book1
	A
1	Harry Potter
2	Hermione Granger
3	Ron Weasley
tableData

Column F : search last first & last name from column E
Column G : extract last matching name

Sub test2()
Dim dict As New Dictionary
dict.CompareMode = vbTextCompare

a = Sheets("tabledata").Range("a1:a" & Sheets("tabledata").Cells(Rows.Count, "A").End(xlUp).Row)

With Sheets("test")

    For Each ss In .Range("e1:e" & .Cells(Rows.Count, "e").End(xlUp).Row)
    e = Split(ss.Value, "; ")
   
    For i = 1 To UBound(a, 1)
        dict.Add a(i, 1), i
    Next i
   
    For i = 0 To UBound(e, 1)
        If dict.Exists(e(i)) Then
            b = e(i)
        End If
    Next i
   
    ss.Offset(0, 1).Value = Right(ss.Value, Len(ss.Value) - InStrRev(ss.Value, "; ") - 1)
    ss.Offset(0, 2).Value = b
    dict.RemoveAll
    b = Empty
    Next ss

End With

End Sub