Text to Columns help with my data

[smoloco]

Hi gang,

Thanks in advance for any help you have:

I've got data in a column that looks roughly like this:

JOHNS PLUMBING (e-mail address removed)

Note, all the data in the column has the company name FIRST in capital
letters. The email address for the company is immediately after the
company name (and never has a space between the company and the email
address). Also, the email address always is in small caps.

So, here's the challenge: I need to turn this single data column into
two columns: one column for the company name and another column for the
email address.

I surely need the help with the formula or the excel tool.

Thanks in advance!

Steve

 

[Guest]

Steve:

Try this one. Position the cursor in a cell in the column with the data.

It does not work properly if there are numbers or other symbols.

ie 123 (e-mail address removed)
gives 123 CORP123@123 and corp.com

I'm not sure if that is a concern.

Sub split_name_email_name()
Dim lRowStart As Long, lRowEnd As Long, lRow As Long
Dim lColumn As Long
Dim lFirstLC As Long, lLen As Long
Dim s As String
Dim c As String

Application.ScreenUpdating = False
lRowStart = ActiveCell.CurrentRegion.Row
lColumn = ActiveCell.CurrentRegion.Column
lRowEnd = lRowStart + ActiveCell.CurrentRegion.Rows.Count - 1

For lRow = lRowStart To lRowEnd
s = Cells(lRow, lColumn)
lLen = Len(s)
lFirstLC = 1
Do While lFirstLC <= lLen
c = Mid(s, lFirstLC, 1)
If c >= "a" And c <= "z" Then
Cells(lRow, lColumn + 1) = Left(s, lFirstLC - 1)
Cells(lRow, lColumn + 2) = Right(s, lLen - lFirstLC + 1)
Exit Do
End If
lFirstLC = lFirstLC + 1
Loop
Next lRow

Application.ScreenUpdating = True
End Sub