Split multiple names....

[Nicho]

Hi,

I have and issue where I have name in one cell and need to separate them into 2 cells. Trouble is it is a combination of single names, husband and wife, and partners with different surnames. Sample of data is below:

Belinda Smith & Grant Jones
Janine
Ken & Marie Smith
Louie & Betty Johnson
Naomi Thomsoon & Craig Brown
Narele & Barry Day
Nicholas & Julie Smithson
S M Bole & Co
Jim Morris
Danielle & JohnSimpson

I would appreciate any advice.

Thanks,

Nicho

 

[jindon]

Ahhh

Function nicho(txt As String) As Variant
With CreateObject("VBScript.RegExp")
     .Pattern = "(\D+)\s&\s(\D+)\s(\D+)"
     If .test(txt) Then
          nicho = Array(.replace(txt, "$1 $3"), .replace(txt,"$2 $3"))
          Exit Function
     End If
     .Pattern = "Co(rp|mpany|-?op)?$"
     If .test(txt) Then
          nicho = Array(txt,"")  '<- this lne was Arra(txt,""), missing "y"
          Exit Function
     End If
     .Pattern = "^(.+)\s(.+)\s&\s(.+)\s(.+)$"
     If .test(txt) Then
          nicho = Array(.replace(txt,"$1"), .replace(txt,"$3"))
          Exit Function
     End If
     .Pattern = "&"
     If Not .test(txt) Then
          nicho = Array(txt, "")
          Exit Function
     End If
End With
End Function

 

[Nicho]

Hi Guys,

I have an unusual variation to the request this time. Client wants this and I know it's dumb but this is what they need and I can't figure it out based on the info you have given me (not smart enough!). Their new system needs the info in a different way than originally planned.

They have the following as contacts in column A:

Belinda Jones & Grant Smith
Ken & Marie Johnson
Bart Simpson

They need this separated into a Contact 1 and Contact 2 so that it ends up like this:

Contact1 Contact 2
Belinda Jones & Grant Smith
Ken & Marie Johnson
Bart Simpson

This is a list of 10,000 names and I have no idea so if someone could help it would be greatly appreciated. (Sorry to be a pain in the $^%#^% Jindon if it is you that comes to my rescue!)

Thanks!

 

[jindon]

Sub test()
Dim a(), i As Long
With Range("a1").CurrentRegion
     a = .Value
     ReDim Preserve a(1 To UBound(a,1), 1 To 3)
     For i = 2 To UBound(a,1)
          a(i,2) = nicho(a(i,1), 1) : a(i,3) = nicho(a(i,1),2)
     Next
     .Resize(,3).Value = a
End With
End Sub

Function nicho(txt As String, ref As Byte) As String
With CreateObject("VBScript.RegExp")
     .Pattern = "(\D+)\s&\s(\D+)\s(\D+)"
     If .test(txt) Then
          nicho = Array(.replace(txt, "$1 & $2"), .replace(txt,"$3"))(ref - 1)
          Exit Function
     End If
     .Pattern = "Co(rp|mpany|-?op)?$"
     If .test(txt) Then
          nicho = Array(txt,"")(ref - 1)
          Exit Function
     End If
     .Pattern = "^(.+)\s(.+)\s&\s(.+)\s(.+)$"
     If .test(txt) Then
          nicho = Split(txt,"&")(ref-1)
          Exit Function
     End If
     .Pattern = "&"
     If Not .test(txt) Then
          nicho = Array(txt, "")(ref - 1)
          Exit Function
     End If
End With
End Function

 

[Nicho]

Hi Jindon,

I am entering that and getting a #Value! error.

I noticed the formatting was lost on my last post as well even thought it previewed correctly. It should read:

Current
Belinda Jones & Grant Smith
Ken & Marie Johnson
Bart Simpson

Need to get to:

Contact 1
Belinda Jones & Grant
Ken & Marie
Bart

Contact 2
Smith
Johnson
Simpson

Sorry for the confusion....

Nicho

 

[jindon]

Hit Alt + F8 then select "test" and hit "Run"

You don't need to enter the formula in the cell this time

 

[Nicho]

Hey jindon,

Compile error:ByRef argument type mismatch

at: a(i, 2) = nicho(a(i, 1), 1): a(i, 3) = nicho(a(i, 1), 2)

 

[jindon]

Ok then
Formula in cell as before

Function nicho(txt As String) As Variant
With CreateObject("VBScript.RegExp")
     .Pattern = "(\D+)\s&\s(\D+)\s(\D+)"
     If .test(txt) Then
          nicho = Array(.replace(txt, "$1 & $2"), .replace(txt,"$3"))
          Exit Function
     End If
     .Pattern = "Co(rp|mpany|-?op)?$"
     If .test(txt) Then
          nicho = Array(txt,"") 
          Exit Function
     End If
     .Pattern = "^(.+)\s(.+)\s&\s(.+)\s(.+)$"
     If .test(txt) Then
          nicho = Array(.replace(txt,"$1 $2 & $3"), .replace(txt,"$4"))
          Exit Function
     End If
     .Pattern = "&"
     If Not .test(txt) Then
          nicho = Array(txt, "")
          Exit Function
     End If
End With
End Function

 

[Nicho]

Hey Jindon,

Compile Syntax error at:

nicho = Array(.replace(txt,"$1 $2 & "$3"), .replace(txt,"$4"))

 

[jindon]

Hey Jindon,

Compile Syntax error at:

nicho = Array(.replace(txt,"$1 $2 & "$3"), .replace(txt,"$4"))

Too much "

nicho = Array(.replace(txt,"$1 $2 & $3"), .replace(txt,"$4"))

 

[Nicho]

Hey Jindon...that is working pretty well now. The only thing it is missing is if there is a single person e.g. Bob Smith, it is putting the whole name in the first column instead of putting Bob in Column 1 and Smith in Column 2.