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