Extract email addresses

G

Guest

Hi

I have been looking for an answer to this for weeks - and I admit defeat!
I have a column of data with email addresses in there, somewhere. Each email
is preceeded and followed by a space. There are also non-printing 'squares'
in there - but I'm not sure if that makes a difference or not!
Sample text could be
This message has been returned .. . . address was (e-mail address removed) and
this address . . . . . etc

So I am trying to extract the section of text with the @ sign, up to but
excluding the spaces at both ends.
Help me, please!
Andy.
 
B

Bob Phillips

Try this array formula

=MID(A1,MAX(IF((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)="
")*(ROW(INDIRECT("1:"&LEN(A1)))<FIND("@",A1)),ROW(INDIRECT("1:"&LEN(A1)))))+1,
FIND(" ",A1&"
",FIND("@",A1))-1-MAX(IF((MID(A1,ROW(INDIRECT("1:"&LEN(A1))),1)="
")*(ROW(INDIRECT("1:"&LEN(A1)))<FIND("@",A1)),ROW(INDIRECT("1:"&LEN(A1))))))

as an array formula, it is committed with Ctrl-Shift-Enter, not just Enter.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)
 
G

Guest

Thanks Bob. I 'm most grateful for your help! I am still left with a lot of
email addresses with space at either end and with preceeding/trailling
'squares'. I think they are carriage returns and have tried replacing
chr(13) and chr(9) with macros, but have made no progress.
Cheers anyway.
Andy.
 
B

Bob Phillips

You can use TRIM to get rid of spaces. Also, try Chr(10) and CHR(160).

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)
 
G

Guest

Thanks again, Bob!!

Andy.

Bob Phillips said:
You can use TRIM to get rid of spaces. Also, try Chr(10) and CHR(160).

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)
Click to expand...
 
R

Ron Rosenfeld

Hi

I have been looking for an answer to this for weeks - and I admit defeat!
I have a column of data with email addresses in there, somewhere. Each email
is preceeded and followed by a space. There are also non-printing 'squares'
in there - but I'm not sure if that makes a difference or not!
Sample text could be
This message has been returned .. . . address was (e-mail address removed) and
this address . . . . . etc

So I am trying to extract the section of text with the @ sign, up to but
excluding the spaces at both ends.
Help me, please!
Andy.
Click to expand...

You can do it using Regular Expressions. These can be implemented in VBA or
with an add-in.

To implement it in VBA, <alt-F11> opens the VB Editor.

Ensure your project is highlighted in the Project Explorer window.
Insert/Module and paste the code below into the window that opens.
From the top menu, Tools/References and select Microsoft VBScript Regular
Expressions 5.5.

Then try this formula:

=remid(A1,"\b\S+@\S+(?=\s)")

===========================================
Option Explicit

Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===================================


--ron
 
R

Ron Rosenfeld

Because of a difference in the VBA flavor of Regular Expressions, the following
formula should work better:

=remid(A1,"\b\S+@[^ \f\n\r\t\v\xA0]+")

or

=remid(A1,"\b\S+@[^ \f\n\r\t\v\x80-\xFF]+")

The issue has to do with handling of characters with an ASCII value > 127 by
the \S token.





You can do it using Regular Expressions. These can be implemented in VBA or
with an add-in.

To implement it in VBA, <alt-F11> opens the VB Editor.

Ensure your project is highlighted in the Project Explorer window.
Insert/Module and paste the code below into the window that opens.
From the top menu, Tools/References and select Microsoft VBScript Regular
Expressions 5.5.

Then try this formula:

=remid(A1,"\b\S+@\S+(?=\s)")

===========================================
Option Explicit

Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===================================


--ron
Click to expand...

--ron
 
G

Guest

Ron

That's amazing!! I don't know if it's amazing because it works so well - or
because I don't know how the hell it does it!!

Cheers.
Andy.

Ron Rosenfeld said:
Because of a difference in the VBA flavor of Regular Expressions, the
following
formula should work better:

=remid(A1,"\b\S+@[^ \f\n\r\t\v\xA0]+")

or

=remid(A1,"\b\S+@[^ \f\n\r\t\v\x80-\xFF]+")

The issue has to do with handling of characters with an ASCII value > 127
by
the \S token.





You can do it using Regular Expressions. These can be implemented in VBA
or
with an add-in.

To implement it in VBA, <alt-F11> opens the VB Editor.

Ensure your project is highlighted in the Project Explorer window.
Insert/Module and paste the code below into the window that opens.
From the top menu, Tools/References and select Microsoft VBScript Regular
Expressions 5.5.

Then try this formula:

=remid(A1,"\b\S+@\S+(?=\s)")

===========================================
Option Explicit

Function REMid(str As String, Pattern As String, _
Optional Index As Variant = 1, _
Optional CaseSensitive As Boolean = True) _
As Variant 'Variant as value may be string or array

Dim objRegExp As RegExp
Dim objMatch As Match
Dim colMatches As MatchCollection

Dim i As Long 'counter
Dim t() As String 'container for array results

' Create a regular expression object.
Set objRegExp = New RegExp

'Set the pattern by using the Pattern property.
objRegExp.Pattern = Pattern

' Set Case Insensitivity.
objRegExp.IgnoreCase = Not CaseSensitive

'Set global applicability.
objRegExp.Global = True

'Test whether the String can be compared.
If (objRegExp.Test(str) = True) Then

'Get the matches.
Set colMatches = objRegExp.Execute(str) ' Execute search.

On Error Resume Next 'return null string if a colmatch index is
non-existent
If IsArray(Index) Then
ReDim t(1 To UBound(Index))
For i = 1 To UBound(Index)
t(i) = colMatches(Index(i) - 1)
Next i
REMid = t()
Else
REMid = CStr(colMatches(Index - 1))
If IsEmpty(REMid) Then REMid = ""
End If
On Error GoTo 0 'reset error handler
Else
REMid = ""
End If
End Function
===================================


--ron
Click to expand...

--ron
Click to expand...
 
R

Ron Rosenfeld

Ron

That's amazing!! I don't know if it's amazing because it works so well - or
because I don't know how the hell it does it!!

Cheers.
Andy.
Click to expand...


Regular Expressions are a very powerful tool to use for working with strings.

Here's some information on Regular Expressions and using them in VBA:

http://www.regular-expressions.info/reference.html
http://support.microsoft.com/default.aspx?scid=kb;en-us;818802&Product=vbb
http://msdn.microsoft.com/library/d...html/2380d458-3366-402b-996c-9363906a7353.asp


For an implementation done as an add-in, which can handle strings up to 255
characters in length, download and install Longre's free morefunc.xll add-in
from http://xcell05.free.fr (There are a bunch of other useful functions in
this add-in also).


--ron
 
R

RichardSchollar

Hi Andy

This is an alternative formula method:

=TRIM(MID(SUBSTITUTE(" "&A1," ",REPT(" ",20)),FIND("@",SUBSTITUTE("
"&A1," ",REPT(" ",20)))-20,40))

It just needs enter (it's not a CSE formula).

Best regards

Richard
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Macro: VBA code to move/forward email based on subjects and attachments 0
How to extract email addresses from a word document 2
hyperlinking email addresses 1
Extract emails from cells with text 1
outlook email addresses extraction 0
extract addresses... 5
I would like to extract email addresses from an Excel document 1
Rule for notifying personal email addresses from shared address 0

Top