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
(e-mail address removed)
1 555 A St (e-mail address removed)
Everywhere, USA
(e-mail address removed)
(e-mail address removed)
2 557 A St (e-mail address removed)
Everywhere, USA
3 (e-mail address removed)
So column A is the information I have (some address have multiple email
address), and column B is what I want. Any ideas?
Thanks
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
