export 2 emails from one excel cell

Microsoft Excel 2003 (full product)
June 8, 2010 at 14:10:47
Specs: windows 2003
I have a column in excel. In each cell of that column there is lots of text which includes 2 email addresses. I want to extract both of these email addresses into two separate columns in excel. I have managed to find a way to extract the first email address but cant find a way of extracting them both.
Can anyone help me? it is driving me mad!

See More: export 2 emails from one excel cell

June 8, 2010 at 15:21:20
I'm having a hard time seeing the OP's spreadsheet from where I'm sitting.

Can anyone else (besides the OP) see it?

In other words...Imagine how much more help we could be if we knew how the "lots of text" and email addresses are laid out in the cell.

Report •

June 9, 2010 at 00:13:07
The "lot of text" refers to 200 words of text about a person, their telephone number and their postal address, as well as two email addrses. i need to extract both of these email addresses from the paragraph of text, into to separate columns.

Report •

June 9, 2010 at 05:02:02
I'll try to be more specific.

Please post an example of the text in a cell so we can see what the text looks like.

Without an example of your actual text all we can do is hope that we set up a cell that matches yours and then create a formula (or VBA routine) to extract the email addresses.

I have some ideas, but I don't want to waste time testing a solution that might not work on your data structure.

There is no built in "extract 2 emails from a cell full of text" function in Excel, so any solution has to be custom built based on the exact layout of your text.

Please post an complete example of cell (with real names changed to protect the owner's).

You said "I have managed to find a way to extract the first email address". Please post how you did that also.

As I said before, we can't see your spreadsheet from where we're sitting, so we have no idea what solution to offer.

Report •

Related Solutions

June 9, 2010 at 05:34:16
Here is an example of the text in one cell. I hope this helps more. Thank you very much.

Hello Claire,
My friend and i would like to attend the event that you are organising. Her email address is xxxxx@blah.com and her telephone number is 088999393 and my email address is me@hotmail.com.
I look forward to hearing from you.

Report •

June 9, 2010 at 07:17:31
Here's a VBA method of extracting both email addresses, based on your example.

The code works as follows:

1 - It uses TextToColumns to place each word in the original cell into individual cells.

2 - It then searches through the individual cells looking for cells that contain both an @ sign and a "dot" (period). It then assumes that that is an email address. We could harden that up by searching for an @ sign plus a (.com or .net or .edu or .org) etc.

3 - When it finds an @ and a dot it copies that cell to Sheet2 Column A.

4 - If the 'suspected" email address ends in a period (like the one in your example) the code strips off the period.

It works for your example, but may need some tweaking if some of the text in the cells is laid out differently.

Note: The code assumes the following:

- The cells with the original text begin in Sheet1!A1
- The rest of that row is empty and available for the TextToColumns function to do it's job
- Sheet2 Column A is available to accept the copied email addresses.

Let me know what you think.

Option Explicit
Sub ExtractEmail()
Dim lastTxtRow, nxtRow, nxtCol, lastTxtCol, nxtAddyRow As Integer
'Determine last row of text in Sheet1, Column A
  lastTxtRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
'Loop through Column A
   For nxtRow = 1 To lastTxtRow
'Split text into individual cells
     Sheets(1).Cells(nxtRow, 1).TextToColumns _
       Destination:=Sheets(1).Cells(nxtRow, 2), DataType:=xlDelimited, _
       TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
       Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
       :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
'Determine last column in current Row
        lastTxtCol = Sheets(1).Cells(nxtRow, Columns.Count).End(xlToLeft).Column
'Loop through current Row, looking for @ sign
         For nxtCol = 2 To lastTxtCol
          If Sheets(1).Cells(nxtRow, nxtCol) Like "*@*" And _
          Sheets(1).Cells(nxtRow, nxtCol) Like "*.*" Then
'If found, determine next empty Row on Sheet2
           nxtAddyRow = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row + 1
'Copy email address to Sheet2
            Sheets(1).Cells(nxtRow, nxtCol).Copy Destination:=Sheets(2).Cells(nxtAddyRow, 1)
'Check for Period at end of email address, strip off if found
             If Right(Sheets(2).Cells(nxtAddyRow, 1), 1) = "." Then
              Sheets(2).Cells(nxtAddyRow, 1) = _
              Left(Sheets(2).Cells(nxtAddyRow, 1), Len(Sheets(2).Cells(nxtAddyRow, 1)) - 1)
             End If
          End If
'Loop and work on next cell
End Sub

Report •

June 10, 2010 at 03:28:53
Thank you very much for this. Where do i paste the VBA code that you gave me so that i can see if it works?
Thank you

Report •

June 14, 2010 at 05:00:10
Hello Helpful Person,
I am still desperate to resolve this issue. Where do i put this VBA code that you have written for me?
Thank you for your help

Report •

June 14, 2010 at 06:23:45

Right-click the name tab of the worksheet containing the e-mail texts.
Select 'View Code'
In the large Visual Basic window, paste the code.

Select Save from the Visual Basic menu to save the code along with the workbook.

Click to put the cursor somewhere inside the code.
Click the f8 button to start the code in single-step mode.
Either continue in single step mode with f8 for each line, or click f5 to run the rest of the code.

If single stepping you can often see the results of parts of each line by hovering the mouse over variables in the code.

Alt + f11 takes you back to the main Excel window.


Report •

Ask Question