formula to see if a surname is repeated within a cell and output a simplified string
I have a list of several thousand items, which consist of several different names together like this:
Mr P Thompson & Mrs S Thompson & Mr A Thompson Mr C Guy-Johnson & Mrs A Guye-Johnson & Miss J Guye-Johnson Mrs Fuller & Ms D Fuller & Dr K U Fuller Dr V Patel & Dr OO Patel Mr B Burden & Mr MP Wood & Ms C Pollock Mr PW Philips & Mrs PW Philips Dr D Watson & S Holmes Mr R Polanski & Mrs S Polanski Mr S Spielberg & Miss G Spielberg & Mrs T Spielberg
Sometimes the surname is repeated within the cell, sometimes it is not.
I want to build a formula that will determine if the surname is repeated, and return a string where the Salutations/titles and inititals are concatenated with the Surname at the end, unless the surnames are different.
- Mr S Spielberg & Miss G Spielberg & Mrs T Spielberg - Mr R Polanski & Mrs S Polanski
- Mr S & Miss G & Mrs T Spielberg - Mr R & Mrs S Polanski
- Mr B Burden & Mr MP Wood & Ms C Pollock - Dr D Watson & S Holmes
would remain the same as the surnames are different
Is it possible to do that with formulas, (and not splitting the names using Text to Columns), and how would I do that please?
I am sure Barry or Lori would come up with a smart formula :) However here is a VBA example which might just solve your boss's breathing problem ;)
Paste this code in a module. (Tested only with the samples in the screenshot below). I took the liberty to manipulate one of the cell values to take into consideration multiple matches in surnames. See Cell A1
Function GetNewNames(rng As Range) As String Dim MyAr() As String, tmpAr() As String Dim prevValue As String, sTmp As String, surName As String, sTemp As String Dim i As Long Dim col As New Collection Dim itm As Variant On Error GoTo Whoa: If Not rng Is Nothing Then prevValue = rng.Value If InStr(1, prevValue, "&") Then MyAr = Split(prevValue, "&") For i = 0 To UBound(MyAr) sTmp = Trim(MyAr(i)) If InStr(1, sTmp, " ") Then tmpAr = Split(sTmp, " ") surName = tmpAr(UBound(tmpAr)) Else surName = sTmp End If On Error Resume Next col.Add surName, Chr(34) & surName & Chr(34) On Error Resume Next Next i For Each itm In col For i = 0 To UBound(MyAr) sTmp = Trim(MyAr(i)) If InStr(1, sTmp, " ") Then tmpAr = Split(sTmp, " ") surName = tmpAr(UBound(tmpAr)) Else surName = sTmp End If If surName = itm Then If sTemp = "" Then sTemp = Trim(MyAr(i)) Else sTemp = Replace(sTemp & " & " & Trim(MyAr(i)), itm & " &", "&") End If End If Next i Next GetNewNames = sTemp Else GetNewNames = prevValue End If End If Exit Function Whoa: GetNewNames = "" End Function