Excel udf: Filter emails from an excel range
Filed in Excel, Search/Lookup, User defined functions (udf) on Mar.16, 2011. Email This article to a Friend
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 FunctionWhere 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)
Related posts:
User defined function to split words in a cell range into a cell each in excel
Filter unique words from a range in excel (udf)
Filter duplicate words from a cell range in excel (udf)
Excel udf: Combine cell ranges into a single range while eliminating blanks
Recommended categories
[...] 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!