Split list of names and add title

A recent project brief managed by datanology related to the agreed marketing data of a companies client list. In order to create a more formal yet personal approach, the list of 30,000 names needed to have the title (Mr / Ms) prefixed and to assist in the recording of the emails sent out, the first name and surname in separate fields.

The first task was to split the full names in column A and it was decided that as there could be any number of records in this task, and to make it fully reusable we would use VBA. We could have split the names using a delimiter command or function and delimit by space. However, we had a far more efficient method of splitting these names and appending them to 2 separate columns, afterall we knew that there were only 2 names and these were always separated by a space.

The code example below contains 2 UDFs to get the first and last words from the cell. These functions are useful in their own right but really prove how powerful they can be when used in a VBA script. The main part of the code example splits the names accordingly and then loops back down through all the first names to determine if they are male or female. This is not something that can be done with a function or hard set of rules because names are essentially just random words when it comes to a computer understanding them. The list of male names is stored in column A of sheet2 and female names in column B of sheet2. These lists can be added to at any time, and the reason we use a countif function is the speed that this allows in VBA. If we were to loop through each name and determine a match yes/no it could take quite some time.

This code below can be adapted for your own use, or feel free to leave us a message or contact us for further assistance on your project.



Function GETFIRSTWORD(Text As String, Optional Separator As Variant)
Dim firstword As String
If IsMissing(Separator) Then
Separator = " "
End If
firstword = Left(Text, InStr(1, Text, Separator, vbTextCompare))
GETFIRSTWORD = Replace(firstword, Separator, "")
End Function


Function ReturnLastWord(The_Text As String)
Dim stGotIt As String
stGotIt = StrReverse(The_Text)
stGotIt = Left(stGotIt, InStr(1, stGotIt, " ", vbTextCompare))
ReturnLastWord = StrReverse(Trim(stGotIt))
End Function


Sub Button1_Click()
'Last row in A
With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For nm = 2 To lastrow
'Split first name and surname out to D and E
ActiveSheet.Range("D" & nm) = GETFIRSTWORD(ActiveSheet.Range("A" & nm))
ActiveSheet.Range("E" & nm) = ReturnLastWord(ActiveSheet.Range("A" & nm))
Next nm
'Loop down column D and if appears in sheet2 column A then C = Mr
'If in column B of sheet2 then it's Ms.
For n = 2 To lastrow
If WorksheetFunction.CountIf(Worksheets("Sheet2").Range("A:A"), ActiveSheet.Range("D" & n)) > 0 Then
ActiveSheet.Range("C" & n) = "Mr"
End If
If WorksheetFunction.CountIf(Worksheets("Sheet2").Range("B:B"), ActiveSheet.Range("D" & n)) > 0 Then
ActiveSheet.Range("C" & n) = "Ms"
End If
Next n
End Sub


Contact us for some advice and guidance on how your Excel development could be created and start helping your business straight away. Contact Us

Datanology

Leave a Reply

Your email address will not be published. Required fields are marked *