Text to Columns help with my data

S

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 [email protected]

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
 
M

Martin Fishlock

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 [email protected]
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
 
Top