Excel 2007 : Remove Unwanted Text from Cells

Good day everyone,
I'll try to be as clear as possible with this question. I have a column with 500 rows and they contain different data but they all have an email address in them.
i.e.
row A1 : Hello my name is John and my email is john@mail.com thanks
row A2 : Hi, my name is Sam and I have an email sam@sam.com good bye.
row.....etc.

what do I want to do? I want to get all email addresses from all rows, without all the rest of the text. I dont know how to do that, but I imagine it would be some sort of rule that detects the @ symbol, then selects the text before the @ until the first space, and then the text after the @ symbol until the first space, and deletes everything else in the cell.

maybe Im just nuts and this is not possible but I thought I would ask the experts.

thanks all for your help!

Hi There
You could use Text To Columns to separate all of your text into columns then leave the email address?.

Data
Text To Columns
COnvert text to columns wizard
Delimited
Next
Select space as the delimter
Next
finish

this will leave you a column with your email addresses.

Hope that helps

Barbara

http://www.howtoexcelatexcel.com

rickygzz,

Barbara Excel does bring up a method that will split the text strings into several different columns. However, because the text strings don't follow a set pattern and have differing amounts of words, the email addresses will end up in different columns. Also without something reliable for the =MID() formula to look for other than the @ symbol, I turned to creating a macro to extract the email addresses quickly and easily.

Attached is a sample workbook that contains a button named "Get Emails" which is assigned to the following macro:

Sub GetEmailMacro_for_rickygzz()
    
    Const TextCol As String = "A"
    Const StartRow As Long = 2
    
    Dim Entries() As Variant, TextParts() As String, Emails() As String
    Dim EntryIndex As Long, PartIndex As Long, EmailIndex As Long
    
    Range(TextCol & StartRow).Offset(0, 1).Resize(Rows.Count - 100, 1).ClearContents
    Entries = Range(TextCol & StartRow, Cells(Rows.Count, TextCol).End(xlUp)).Value
    
    For EntryIndex = 1 To UBound(Entries, 1)
        TextParts = Split(Entries(EntryIndex, 1), " ")
        For PartIndex = 0 To UBound(TextParts)
            If InStr(TextParts(PartIndex), "@") > 0 Then
                EmailIndex = EmailIndex + 1
                ReDim Preserve Emails(1 To EmailIndex)
                Emails(EmailIndex) = Trim(TextParts(PartIndex))
                Exit For
            End If
        Next PartIndex
    Next EntryIndex
    
    Range(TextCol & StartRow).Offset(0, 1).Resize(UBound(Emails), 1).Value = WorksheetFunction.Transpose(Emails)
    
End Sub

Hope that helps,
~tigeravatar

EDIT: We posted at the same time, rickygzz

Thank you for your prompt response Barbara.
That option would work perfectly if all text was equal and I just needed to pull the emails out of the same column. Unfortunately, since all text for each cell varies, the email addresses are put in different columns, which difficults the extraction as the number of rows is bigger than 500.

I'll appreciate any further input you are able to provide.

Thanks TigerAvatar,
I will try to implement that solution and get back to post the results.

Thank you TigerAvatar, this worked perfectly.

have a nice day and weekend!

Just want to say thanks so much for this!! I have been wrestling with the same problem for hours. I Googled it, wound up here and bingo! Your sheet/macro fixed it! Thanks again!!