A Complex Data Splitting Task

[ToddOdd]

I have a column of information, in 1 worksheet, that has name data that literally looks like this:

JohnSmith - Owner

The first and last names are not separated by anything, only showing up as different words because of capitalization. The "Job Title" in this column is separated by a space, a hyphen, and a space (" - ")

What I would like to do is split this data up into 3 different columns - one column with the parsed out first name, one with the last name, and one with the Owner. A function or macro would be ideal, but I am not sure how to handle this because of the odd situation with the capitalization.

Any suggestions?

ToddOdd

 

[pgc01]

Hi ToddOdd
Welcome to the board

A function or macro would be ideal, but I am not sure how to handle this because of the odd situation with the capitalization.

I don't see why you say it's an "odd capitalization". You can simply loop through the characters and check if they are upper- or lowercase.

Another option is to use a regular expression. For example, assuming the data in column A starting in row 2, try::

Sub SplitCell()
Dim rRng As Range, rCell As Range
 
Set rRng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
With CreateObject("VBScript.RegExp")
    For Each rCell In rRng
        .Pattern = "([A-Z][a-z]*)([A-Z][a-z]*) - ([A-Za-z]+)"
        If .test(rCell) Then rCell.Offset(, 1).Resize(, 3) = Split(.Replace(rCell, "$1 $2 $3"))
    Next rCell
End With
Application.ScreenUpdating = True
End Sub

 

[ToddOdd]

A thing of beauty and elegance. Thank you for saving me hours of time!!!

ToddOdd

 

[pgc01]

I'm glad it helped.

I noticed that I defined the regex pattern inside the loop and it should have been outside. This will have no effect in the result but it's more efficient and makes more sense:

Sub SplitCell()
Dim rRng As Range, rCell As Range
 
Set rRng = Range("A2", Range("A" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
With CreateObject("VBScript.RegExp")
    .Pattern = "([A-Z][a-z]*)([A-Z][a-z]*) - ([A-Za-z]+)"
    For Each rCell In rRng
        If .test(rCell) Then rCell.Offset(, 1).Resize(, 3) = Split(.Replace(rCell, "$1 $2 $3"))
    Next rCell
End With
Application.ScreenUpdating = True
End Sub

Cheers