Strip e-mail from cell

[Keeper4826]

I have a spreadsheet which has a "User Description" column. In this column, most users have data that looks similar to this:

APPLICATION - john.smith@mycompany.com
APPWEB - jane-doe@somecompany.com
APPWEB - john_doe@othercompany.com
APPLICATION - TP - paul@acompany.com
APP/APPWeb/DEV - paulsm@thecompany.com

There are also cells in this column which literally have a sentence long description, but those are not my focus. What I need to do is find a way to strip out the e-mail address found in the examples above and copy them into a new cell (the same row for the corresponding user). I don't know where to begin for this. Can anybody help?

 

[VoG]

You could select the column and use Data > Text to Columns, specifying - as the delimiter.

However that wouldn't work the same with

APPLICATION - TP - paul@acompany.com

but if you haven't got too many with more than one - it may be a viable solution.

 

[brian.wethington]

Are the emails always the last thing in the cell, always after a dash?

 

[Keeper4826]

I reckon I could do that multiple times as needed until I'm left with just an e-mail address. Thanks for help.

 

[Keeper4826]

Are the emails always the last thing in the cell, always after a dash?

There are over 5300 records, so it's hard to say. At first glance though, I would say yes. When the cell contains an e-mail address, it is the last data in the cell and it follows a hyphen.

I tried the text-to-columns suggestion and found a problem. There are a couple addresses which have a hyphen (i.e. john-smith@place.com or paul@my-job.com). These cells got split too much.

 

[brian.wethington]

I was going to suggest creating a small little UDF however it seems there are possibilities for quite a few exceptions. Might still be possible but here is a simple idea of a UDF that handles no exceptions:

Function EmailEnd(Txt As String, Optional Delim As String = "-") As String
Dim Dp As Variant

Dp = Split(Txt, Delim)
EmailEnd = Trim(Dp(UBound(Dp)))

End Function

I will continue looking at it and see if I can find a way to handle the exception you just included.

 

[West Man]

If there is always a space following the dash that precedes the email address, try: =MID(A1,LOOKUP(2^15,FIND("- ",A1,ROW(INDIRECT("1:"&LEN(A1)))))+2,1023)

 

[Scott Huish]

Perhaps:

=TRIM(RIGHT(SUBSTITUTE(A1,"- ",REPT(" ",255)),255))

Book2
	A	B	C	D
1	APPLICATION - john.smith@mycompany.com	john.smith@mycompany.com
2	APPWEB - jane-doe@somecompany.com	jane-doe@somecompany.com
3	APPWEB - john_doe@othercompany.com	john_doe@othercompany.com
4	APPLICATION - TP - paul@acompany.com	paul@acompany.com
5	APP/APPWeb/DEV - paulsm@thecompany.com	paulsm@thecompany.com
6
Sheet1

 

[erik.van.geit]

Hi, try this
  A                                      B                         
1 APPLICATION - john.smith@mycompany.com john.smith@mycompany.com  
2 APPWEB - jane-doe@somecompany.com      jane-doe@somecompany.com  
3 APPWEB - john_doe@othercompany.com     john_doe@othercompany.com 
4 APPLICATION - TP - paul@acompany.com   paul@acompany.com         
5 APP/APPWeb/DEV - paulsm@thecompany.com paulsm@thecompany.com     

Sheet1
[Table-It] version 07 by Erik Van Geit

RANGE FORMULA (1st cell)
B1:B5 =TRIM(RIGHT(SUBSTITUTE(A1," ",REPT(" ",99)),99))

[Table-It] version 07 by Erik Van Geit

kind regards,
Erik

 

[erik.van.geit]

If the email can be in the middle of the string
   A                                          B                          
 7 APPLICATION - john.smith@mycompany.com +++ john.smith@mycompany.com   
 8 APPWEB - jane-doe@somecompany.com other ++ jane-doe@somecompany.com   
 9 APPWEB - john_doe@othercompany.com more    john_doe@othercompany.com  
10 APPLICATION - TP - paul@acompany.com etc   paul@acompany.com          
11 APP/APPWeb/DEV - paulsm@thecompany.com     paulsm@thecompany.com      

Sheet1
[Table-It] version 07 by Erik Van Geit

RANGE   FORMULA (1st cell)
B7:B11  =email(A7)

[Table-It] version 07 by Erik Van Geit

Function email(c As Range)
Dim txt As String
Dim e As Long
Dim s1 As Long
Dim s2 As Long

txt = c.Text
e = InStr(1, txt, "@")
s1 = Len(txt) - InStr(Len(txt) - e, StrReverse(txt), " ") + 1
s2 = InStr(e, txt, " ")
If s2 = 0 Then s2 = Len(txt) + 1
email = Mid(txt, s1 + 1, s2 - s1)

End Function