Extract emails from cells with text

[AJexcelQuestions]

I have a row in column A which includes an email address in the text that I'd
like to extract to column B. Is there a formula I can use to accomplish
extracting the email address only to column B?

Here's an example of different cells in column A:

Please email (e-mail address removed) to contact us......
OR
Schedule an appointment for assistance, or email (e-mail address removed) with your
questions...

Thank you

 

[T. Valko]

Try this...

All on one line:

=TRIM(RIGHT(SUBSTITUTE(LEFT(A1,FIND
(" ",A1&" ",FIND("@",A1))-1)," ",
REPT(" ",LEN(A1))),LEN(A1)))

 

[Don Guillett]

Sub getemailinstr()
Set mc = Range("f4")
findat = InStr(mc, "@")
'MsgBox findat
st = InStrRev(mc, " ", findat)
'MsgBox st
es = InStr(findat, mc, " ")
'MsgBox es
mc.offset(,1).value=Mid(mc, st, es - st)
End Sub

 

[Ron Rosenfeld]

I have a row in column A which includes an email address in the text that I'd
like to extract to column B. Is there a formula I can use to accomplish
extracting the email address only to column B?

Here's an example of different cells in column A:

Please email (e-mail address removed) to contact us......
OR
Schedule an appointment for assistance, or email (e-mail address removed) with your
questions...

Thank you

One way is with a user defined function (UDF).

To enter this User Defined Function (UDF), <alt-F11> opens the Visual Basic
Editor.
Ensure your project is highlighted in the Project Explorer window.
Then, from the top menu, select Insert/Module and
paste the code below into the window that opens.

To use this User Defined Function (UDF), enter a formula like

=ExtractEmail(A1)

in some cell.

This UDF makes the assumption that the email address is defined by being a
single substring that contains a "@". If that is not sufficient, a more
detailed specification can be devised.

=============================================
Option Explicit
Function ExtractEmail(s As String) As String
Dim re As Object, mc As Object
Const sPat As String = "\b\S+@\S+\b"
Set re = CreateObject("vbscript.regexp")
re.Pattern = sPat
If re.test(s) = True Then
Set mc = re.Execute(s)
ExtractEmail = mc(0)
End If
End Function
====================================
--ron

 

[Rick Rothstein]

Here is another UDF for you to consider...

Function ExtractEmail(S As String) As String
Dim Parts() As String
Parts = Split(S, "@")
ExtractEmail = Split(Parts(1))(0)
Parts = Split(Parts(0))
ExtractEmail = Parts(UBound(Parts)) & "@" & ExtractEmail
End Function