Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Extract email(s) from address field

846 views
Skip to first unread message

Eli

unread,
Jun 4, 2009, 2:27:01 PM6/4/09
to
So I have a list of address, where the entire address is in one cell, I want
to extract just the email address from the field. Here is a quick example:

A B
joh...@gmail.com
1 555 A St joh...@gmail.com
Everywhere, USA

Jan...@gmail.com
Love...@gmail.com
2 557 A St Jan...@gmail.com
Everywhere, USA

3 Love...@gmail.com


So column A is the information I have (some address have multiple email
address), and column B is what I want. Any ideas?

Thanks

Ron Rosenfeld

unread,
Jun 4, 2009, 3:58:46 PM6/4/09
to

This can be done using a VBA Macro.

As written, the macro assumes your data is in column A. Examination of the
macro should indicate how you can change that.

Also, the "email pattern" does not match email addresses using an IP address
instead of a domain name. It also does not match email addresses on
new-fangled top-level domains with more than 4 letters such as .museum.

If this is a problem, the pattern can be changed, but it will become more
complex.

To enter this Macro (Sub), <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 Macro (Sub), <alt-F8> opens the macro dialog box. Select the macro
by name, and <RUN>.

==================================
Option Explicit
Sub ExtEmail()
Dim re As Object, mc As Object, m As Object
Dim c As Range, rSrc As Range, rDest As Range
Dim i As Long
Dim S As String

Set rSrc = Range("A:A").SpecialCells(xlCellTypeConstants)
Set rDest = Range("B1")
rDest.EntireColumn.ClearContents
i = 0
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.Global = True
re.Pattern = "\b[A-Z0-9._%+-]+@[A-Z0-9.-]+\.[A-Z]{2,6}\b"

For Each c In rSrc
S = c.Value
If re.test(S) = True Then
Set mc = re.Execute(S)
For Each m In mc
rDest.Offset(i, 0).Value = m
i = i + 1
Next m
End If
Next c
End Sub
==================================
--ron

wise...@antenna.nl

unread,
Feb 6, 2013, 3:30:28 AM2/6/13
to


Fantastic! It works!
Thank youi very much, Markus (WISE Amsterdam)

rapsz...@gmail.com

unread,
Nov 7, 2014, 5:42:53 AM11/7/14
to
You are my hero, many thanks!
0 new messages