problem splitting names from prefixes

[wCJanssen]

Hi

I'm fairly new to vba, but managed to write a code that splits (Dutch) surnames from their prefixes. It works fine for fairly simple names, such as "van den Berg", but when you enter a double-barrelled name, such as "Baron Cohen" of "Rosario de Lima", it mistakes the first part of the name for a prefix. Here's what I've got so far:

Private Sub Test()
pos = InStrRev(txtSurnameIncl.Text, " ")
    txtSurnameExcl.Text = Mid$(txtSurnameIncl.Text, pos + 1, Len(txtSurnameIncl.Text) - pos)
    txtPrefixes.Text = Replace(txtSurnameIncl, " " & txtSurnameExcl.Text, "")
    If txtPrefixes = txtSurnameExcl Then txtPrefixes.Value = ""
txtPrefixes.Text = LCase(txtPrefixes.Text)
End Sub

Does anyone know how this can be solved? Maybe I can add a codeline that makes sure any word longer than three characters is regarded a name? Thanks in advance.

 

[milesUK]

wCJanssen, can you post some data please? Original plus what it should look like afterwards.

 

[wCJanssen]

sure, for instance:

"van den Berg" should be split into "van den" (prefix) and "Berg" (surname)
"de Boer" - "de" (prefix) and "Boer" (surname)
"van Oranje Nassau" - "van" (prefix) and "Oranje Nassau" (surname)
"Jansen" - "" (prefix) and "Jansen" (surname)
"Vennegoor of Hesselink" - "" (prefix) and "Vennegoor of Hesselink" (surname)

thanks for your reply.

 

[milesUK]

In can see a posible solution:

from your data it looks like the prefixes all have lower case initials. Prefix words could be removed upto the first Capital initial leaving the surname complete. Would that work?

One alternative would be a definitive lookup list of prefixes. But that could be a large list!

 

[wCJanssen]

That would do the trick - which command could you use for such a code? Thanks again.

 

[Bill Rockenbach]

Try

Option Explicit
Sub SplitName()
    Dim iLength As Integer
    Dim i As Integer
    Dim sChr As String
    Dim oName As Range
    For Each oName In Range("myRange")
        For i = 1 To Len(oName)
            sChr = oName.Characters(i, 1).Text
            If UCase(sChr) = sChr And sChr <> " " Then
                oName.Offset(0, 1) = Mid(oName, 1, i - 1)
                oName.Offset(0, 2) = Mid(oName, i, Len(oName))
                Exit For
            End If
        Next i
    Next oName
End Sub

 

[wCJanssen]

that works perfect; I forgot to mention that the name is in a userform textbox though, and should be split into two textboxes as well (sorry).

 

[Bill Rockenbach]

Do you need the code for the textboxes?

 

[wCJanssen]

yes, please; Thanks.

 

[Bill Rockenbach]

I assume the textboxes are on a user form

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    Dim i As Integer
    Dim sChr As String
        For i = 1 To Len(TextBox1)
            sChr = Mid(TextBox1.Value, i, 1)
            If UCase(sChr) = sChr And sChr <> " " Then
                TextBox2 = Mid(TextBox1.Value, 1, i - 1)
                TextBox3 = Mid(TextBox1.Value, i, Len(TextBox1.Value))
                Exit For
            End If
        Next i
End Sub