I have a large spreadsheet with email addresses lumped together in the
same column as phone numbers. I am trying to extract the email
addresses and place them in a new column within the same worksheet.

I don't have much of a background in setting up macros or formulas.


Any suggestions?

Hi,

Can you post an example of how your data looks líke?

Regards,
Bondi

Are the phone number universally entered? 7 digits? 10 digits? -s
inbetween?

If there is a SET number of characters for the phone numbers, you can
use this:

=LEFT(A1,LEN(A1)-10)

10 being the number of characters, so you might have to change it to 7
(just numbers), 8 (numbers with a dash), 10 (just number and area
code), 11 (number, area code, and dashes in between)...


--
Bearacade


------------------------------------------------------------------------
Bearacade's Profile: http://www.excelforum.com/member.php...o&userid=35016
View this thread: http://www.excelforum.com/showthread...hreadid=558955

This is a sample of what the information in the cell contains....

555-778-3230 cell 555-252-5972


555-676-5332


555-846-5352 work 555-254-5505 home 555-668-6321 cell



555-761-1436 home 555-216-1286 cell


555-682-5533 work 555-642-7987 cell 555-867-2592 home

The macro below will extract e-mail addresses. It assumes data is in column A
on Sheet1 starting in row 1. The e-mail addresses are put in columns B,C etc



Open Excel, use [Alt]+[F11] to open up the VBA editor. Choose Insert |
Module and cut and paste this into the module:


Sub GetEmailaddress()

Dim lastrow As Long, i As Long
Dim ncol As Integer, spos As Integer
Dim n As Integer, n1 As Integer, n2 As Integer
Dim searchtxt As String
Dim email As String

With Worksheets("Sheet1")

lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
searchtxt = .Range("A" & i)
ncol = 2
spos = 1
Do
n = InStr(spos, searchtxt, "@", vbTextCompare)
If n < 0 Then
n1 = InStrRev(searchtxt, " ", n, vbTextCompare)
n2 = InStr(n, searchtxt, " ", vbTextCompare)
If n2 = 0 Then n2 = Len(searchtxt) + 1
email = Trim(Mid(searchtxt, n1, n2 - n1))
Cells(i, ncol) = email
ncol = ncol + 1
spos = n2
End If
Loop Until n = 0
Next i

End With
End Sub

To run the macro, go to View=Toolbars=Visual Basic. On the visula Basic
toolbar, click the green arrow head ("Run Macro"). The macro below will be
highlighted (if it is the only one) in the "Macro" dropdown. Click RUN.To run
the macro, go to View=Toolbars=Visual Basic. On the Visual Basic toolbar,
click the green arrow head ("Run Macro"). The macro below will be highlighted
(if it is the only one) in the "Macro" dropdown. Click RUN.

HTH

"Inquirer" wrote:

This is a sample of what the information in the cell contains....

555-778-3230 cell 555-252-5972


555-676-5332


555-846-5352 work 555-254-5505 home 555-668-6321 cell



555-761-1436 home 555-216-1286 cell


555-682-5533 work 555-642-7987 cell 555-867-2592 home

When I try this, I get a run-time error it then asks me if I want to
debug when I debug the following string is highlighted.

email = Trim(Mid(searchtxt, n1, n2 - n1))

I did change the "A" to "E" as this is where the data is located.

Any additional suggestions??


Toppers wrote:
The macro below will extract e-mail addresses. It assumes data is in column A
on Sheet1 starting in row 1. The e-mail addresses are put in columns B,C etc



Open Excel, use [Alt]+[F11] to open up the VBA editor. Choose Insert |
Module and cut and paste this into the module:


Sub GetEmailaddress()

Dim lastrow As Long, i As Long
Dim ncol As Integer, spos As Integer
Dim n As Integer, n1 As Integer, n2 As Integer
Dim searchtxt As String
Dim email As String

With Worksheets("Sheet1")

lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
searchtxt = .Range("A" & i)
ncol = 2
spos = 1
Do
n = InStr(spos, searchtxt, "@", vbTextCompare)
If n < 0 Then
n1 = InStrRev(searchtxt, " ", n, vbTextCompare)
n2 = InStr(n, searchtxt, " ", vbTextCompare)
If n2 = 0 Then n2 = Len(searchtxt) + 1
email = Trim(Mid(searchtxt, n1, n2 - n1))
Cells(i, ncol) = email
ncol = ncol + 1
spos = n2
End If
Loop Until n = 0
Next i

End With
End Sub

To run the macro, go to View=Toolbars=Visual Basic. On the visula Basic
toolbar, click the green arrow head ("Run Macro"). The macro below will be
highlighted (if it is the only one) in the "Macro" dropdown. Click RUN.To run
the macro, go to View=Toolbars=Visual Basic. On the Visual Basic toolbar,
click the green arrow head ("Run Macro"). The macro below will be highlighted
(if it is the only one) in the "Macro" dropdown. Click RUN.

HTH

"Inquirer" wrote:

This is a sample of what the information in the cell contains....

555-778-3230 cell 555-252-5972


555-676-5332


555-846-5352 work 555-254-5505 home 555-668-6321 cell



555-761-1436 home 555-216-1286 cell


555-682-5533 work 555-642-7987 cell 555-867-2592 home

Can you send me a copy of w/sheet? toppers<atjohntopley.fsnet.co.uk.
Debugging with data like yours is difficult over the NG!

"Inquirer" wrote:

When I try this, I get a run-time error it then asks me if I want to
debug when I debug the following string is highlighted.

email = Trim(Mid(searchtxt, n1, n2 - n1))

I did change the "A" to "E" as this is where the data is located.

Any additional suggestions??


Toppers wrote:
The macro below will extract e-mail addresses. It assumes data is in column A
on Sheet1 starting in row 1. The e-mail addresses are put in columns B,C etc



Open Excel, use [Alt]+[F11] to open up the VBA editor. Choose Insert |
Module and cut and paste this into the module:


Sub GetEmailaddress()

Dim lastrow As Long, i As Long
Dim ncol As Integer, spos As Integer
Dim n As Integer, n1 As Integer, n2 As Integer
Dim searchtxt As String
Dim email As String

With Worksheets("Sheet1")

lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To lastrow
searchtxt = .Range("A" & i)
ncol = 2
spos = 1
Do
n = InStr(spos, searchtxt, "@", vbTextCompare)
If n < 0 Then
n1 = InStrRev(searchtxt, " ", n, vbTextCompare)
n2 = InStr(n, searchtxt, " ", vbTextCompare)
If n2 = 0 Then n2 = Len(searchtxt) + 1
email = Trim(Mid(searchtxt, n1, n2 - n1))
Cells(i, ncol) = email
ncol = ncol + 1
spos = n2
End If
Loop Until n = 0
Next i

End With
End Sub

To run the macro, go to View=Toolbars=Visual Basic. On the visula Basic
toolbar, click the green arrow head ("Run Macro"). The macro below will be
highlighted (if it is the only one) in the "Macro" dropdown. Click RUN.To run
the macro, go to View=Toolbars=Visual Basic. On the Visual Basic toolbar,
click the green arrow head ("Run Macro"). The macro below will be highlighted
(if it is the only one) in the "Macro" dropdown. Click RUN.

HTH

"Inquirer" wrote:

This is a sample of what the information in the cell contains....

555-778-3230 cell 555-252-5972


555-676-5332


555-846-5352 work 555-254-5505 home 555-668-6321 cell



555-761-1436 home 555-216-1286 cell


555-682-5533 work 555-642-7987 cell 555-867-2592 home