## Filter emails from an excel range [UDF]

*Article updated on January 20, 2018*

This udf extracts all words containing a specified string.

Example,

Cell range B1:M50 contains random sentences. I have inserted some random emails in this range.

### VBA code

Function FilterWords(rng As Range, str As String) As Variant() Dim x As Variant, Wrds() As Variant, Cells_row As Long Dim Cells_col As Long, Words As Long, y() As Variant ReDim y(0) Wrds = rng.Value For Cells_row = LBound(Wrds, 1) To UBound(Wrds, 1) For Cells_col = LBound(Wrds, 2) To UBound(Wrds, 2) x = Split(Wrds(Cells_row, Cells_col)) For Words = LBound(x) To UBound(x) If InStr(x(Words), str) Then y(UBound(y)) = x(Words) ReDim Preserve y(UBound(y) + 1) End If Next Words Next Cells_col Next Cells_row ReDim Preserve y(UBound(y) - 1) FilterWords = Application.Transpose(y) End Function

### Where to do I copy the code?

- Press Alt-F11 to open visual basic editor
- Click Module on the Insert menu
- Copy and paste the user defined function into module
- Exit visual basic editor

### How to use user defined function in excel

- Select sheet1
- Select cell A1
- Type FilterWords(B1:M50, "@") in formula bar
- Press Ctrl + SHIFT + ENTER
- Select cell A1:A5
- Press Ctrl + SHIFT + ENTER

### Download excel sample file for this tutorial.

Filter emails from a cell range.xls

(Excel 97-2003 Workbook *.xls)

Extract unique distinct values from a filtered table [udf and array formula]

Robert Jr asks: Oscar, I am using the VBA code & FilterUniqueSort array to generate unique lists that drive Selection […]### 4 Responses to “Filter emails from an excel range [UDF]”

### Leave a Reply

**How to add a formula to your comment:**

<code>your formula</code>

Remember to convert less than and larger than signs to html character entities before you post your comment.

**How to add VBA code to your comment:**

[vb 1="vbnet" language=","]

VBA code

[/vb]

**How to add a picture to your comment:**

Upload picture to postimage.org

Add picture link to comment.

**Contact Oscar**

You can contact me through this webpage

[...] Excel udf: Filter emails from an excel range [...]

[...] Excel udf: Filter emails from an excel range [...]

I notice that your UDF requires spaces to delimit the email address. For example, if the email address is surrounded by parentheses or adjacent to punctuation marks, those will remain attached to the returned email addresses. This is because you used a general word parser as the basis for your UDF. I had a robust email address parser function that I wrote awhile ago, so I wrote a front-end function (the UDF) that repeatedly calls it as needed; doing this makes the UDF return only the email addresses no matter what other delimiting characters surround them. Just copy the following two functions into a standard Module, then select a column of cells (more than you think email addresses exist), enter this formula in the Formula Bar (change the range as necessary)...

=FindEmailAddresses(B1:M50)

and then press CTRL+SHIFT+ENTER to commit the array formula. By the way, the GetEmailAddress function below can be used as a stand-alone function by itself... it returns a single email address (the first it finds in the text passed to it). Okay, here are the functions...

Function FindEmailAddresses(Rng As Range) As Variant()

Dim Temp As String, Cell As Range, EM() As Variant

ReDim EM(0)

For Each Cell In Rng

Temp = Cell.Value

Do While InStr(Temp, "@")

EM(UBound(EM)) = GetEmailAddress(Temp)

Temp = Replace(Temp, "@", "", 1, 1)

ReDim Preserve EM(UBound(EM) + 1)

Loop

Next

ReDim Preserve EM(UBound(EM) - 1)

FindEmailAddresses = WorksheetFunction.Transpose(EM)

End Function

Function GetEmailAddress(ByVal S As String) As String

Dim X As Long, AtSign As Long

Dim Locale As String, DomainPart As String

Locale = "[A-Za-z0-9.!#$%&'*/=?^_`{|}~+-]"

Domain = "[A-Za-z0-9._-]"

AtSign = InStr(S, "@")

For X = AtSign To 1 Step -1

If Not Mid(" " & S, X, 1) Like Locale Then

S = Mid(S, X)

If Left(S, 1) = "." Then S = Mid(S, 2)

Exit For

End If

Next

AtSign = InStr(S, "@")

For X = AtSign + 1 To Len(S) + 1

If Not Mid(S & " ", X, 1) Like Domain Then

S = Left(S, X - 1)

If Right(S, 1) = "." Then S = Left(S, Len(S) - 1)

GetEmailAddress = S

Exit For

End If

Next

End Function

Rick Rothstein (MVP - Excel),

Thank you for your valuable comment! I tried your functions and they work as you described!