Extract data from sheet - PLEASE HELP

[Frank Homme]

Please help !!
I have several excel files wich contain user information
like names, adresses phonenumbers and emails. I want to
extract only the email adresses, either to a new
workbook, sheet or another location on the same sheet.
The problem is that the emails are in many different
columns. I, some in J, H and so on....

How can i get hold of this email, (using the unik @ is of
course an option, but how)...

I have used hours and days trying to solve this, so
please help me.

(e-mail address removed)

 

[Ron de Bruin]

Are they hyperlinks or text??

In a loop you can do this, place all code in a module and run the sub test
It will copy all E-mail Addresse from "Sheet1" to "Sheet2" , change to yours

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub test()
For Each cell In Sheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
Lr = LastRow(Sheets("Sheet2")) + 1
Set destrange = Sheets("Sheet2").Range("A" & Lr)
cell.Copy destrange
End If
Next cell
End Sub

 

[Norman Harker]

Hi Frank!

One way that appears to work:

=IF(ISERROR(SEARCH("@",A4)),"","mailto:"&HYPERLINK(A4))

The IF function condition looks for the @ in A1.
If there is no @ the SEARCH returns #VALUE!
So:
=ISERROR(SEARCH("@",A1)
will return true if A1 is not an email address and FALSE if it did.

HYPERLINK(A1) will return the email address as a hyperlink but we need
to concatenate this with mailto: to get it properly hotlinked.

Also see:

http://makeashorterlink.com/?Y3EF65515

A post by Dave McRitchie an this problem.

You don't need to spend so long next time struggling with Excel
problems (or post to more than one group). You might also try Google
Searching from within Excel by downloading Ron de Bruin's Google
Search 5.0 tool and user guide from:

http://www.rondebruin.nl/Google.htm

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia
Public Holidays Saturday: Bosnia-Herzegovina (Vivovdan (Orthodox));
Chile (St. Peter & St. Paul Day); Haiti (M'Guine Sauveur table servie
pour maitresse Erzulie, Tenaisse, Mambo); Taiwan (Birthday of Kuan
Kung (God of War)); USA (WW1 Day).
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

 

[Frank Homme]

Thanx for answering Norman.

Unfortually this didnt solve my problem.
I dont need to pyt "mailto:" in front of the mail adress.
The mail adress is in plain text format inside the cell.
Not an hyperlink. I have around 10 worksheets, each with
65000 rows of data, so i have to find an automated
solution.


Is there really not an function i Excel that can find
cells in an worksheet that fulfill an criteria, like an
@, and then either copy or move the cell to another
location, worksheet or workbook?

 

[CLR]

How about just sorting on each column and Copy > Paste them out as a
group.........or Data > Filter > AutoFilter > Custom for equals *.com

Vaya con Dios,

Chuck, CABGx3

 

[Dave Peterson]

One more suggestion:

Start a new workbook.
Hit Alt-F11 (to get to the VBE)
hit ctrl-R to view the project explorer
Find your new project in that Windows Explorer like list.
(should look like VBAProject Book1)

Right click on that and select Insert, then Module.
Paste this in the window that opens:

Option Explicit
Sub ExtractEmails()

Application.ScreenUpdating = False

Dim FoundCell As Range
Dim FirstAddress As String
Dim wks As Worksheet
Dim oCol As Long
Dim oRow As Long
Dim oWks As Worksheet
Dim curWkbk As Workbook

Set curWkbk = ActiveWorkbook

Set oWks = Workbooks.Add(1).Worksheets(1)

oCol = 1
oRow = 1
For Each wks In curWkbk.Worksheets
With wks.Cells
Set FoundCell = .Find(what:="@", LookIn:=xlValues, _
lookat:=xlPart, _
after:=.Cells(.Cells.Count))

If FoundCell Is Nothing Then
'do nothing
Else
FirstAddress = FoundCell.Address
Do
oWks.Cells(oRow, oCol).Value = FoundCell.Value
If oRow < oWks.Rows.Count Then
oRow = oRow + 1
Else
oRow = 1
oCol = oCol + 1
End If

Set FoundCell = .FindNext(FoundCell)
Loop While Not FoundCell Is Nothing _
And FoundCell.Address <> FirstAddress
End If
End With
Next wks

oWks.UsedRange.Columns.AutoFit

Application.ScreenUpdating = True

End Sub


Now hit alt-F11 to get back to excel.

Save this new workbook as: MyEmailExtractor.xls

Open your first file with lots of worksheets with lots of email addresses.
(keep myEmailExtractor.xls open, too)

Hit alt-F8 (to view the list of available macros
select ExtractEmails
click Run

You'll have a new workbook with the emails extracted.

 

[Norman Harker]

Hi Frank!

I can't seem to be able to pull it in without the hyperlink without
have to Right Click > Remove Hyperlink.

You could modify Ron's subroutines:

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function

Sub test()
For Each cell In
Sheets("Sheet1").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "*@*" Then
Lr = LastRow(Sheets("Sheet2")) + 1
Set destrange = Sheets("Sheet2").Range("A" & Lr)
cell.Copy destrange
Destrange.Hyperlinks.Delete
End If
Next cell
End Sub

First Subroutine defines a search range that limits search to used
area of sheet.
Second subroutine checks each cell in the search range
Note that having found a cell with @ and copied it we delete the
hyperlink
It lists all found email addresses below current used range on Sheet2

--
Regards
Norman Harker MVP (Excel)
Sydney, Australia
Public Holidays Saturday: Bosnia-Herzegovina (Vivovdan (Orthodox));
Chile (St. Peter & St. Paul Day); Haiti (M'Guine Sauveur table servie
pour maitresse Erzulie, Tenaisse, Mambo); Taiwan (Birthday of Kuan
Kung (God of War)); USA (WW1 Day).
(e-mail address removed)
Excel and Word Function Lists (Classifications, Syntax and Arguments)
available free to good homes.

 

[David McRitchie]

Hi Frank,
I think you've already chosen Dave Peterson's macro solution as
much more workable, but just some comments on the Worksheet
solution offered by Norman Harker.

This would work
=IF(ISERROR(SEARCH("@",A4)),"",HYPERLINK("mailto:"& A4))

instead of
=IF(ISERROR(SEARCH("@",A4)),"","mailto:"&HYPERLINK(A4))

but it means you have the hyperlink fully visible in two columns.
which is why the link referred to includes a choice like
=HYPERLINK("Mailto:" & A4,"[x]")
which would be better as along the lines of Norman's formula
if the existence of an email link should be checked:
=IF(ISERROR(SEARCH("@",A4)),"",HYPERLINK("mailto:" & A4,"[x]"))

Instead of makeashorterlink the following should stand up to time
even if either of makeashorterlink or Google disappears the link
could be made good because it at least includes the actual message-id.
http://google.com/[email protected]

I don't actually understand the original question concerningIf that means that you do not have consistent columns for the
address, address2, city, state, and zip then I think you should work
on getting the columns aligned.

also what about column K and does the so on mean this could
be any column.

Otherwise you would have to modify Norman's formula to something
like, and you will find this very hard to work with as worksheet formulas.
Enter into the formula bar not the cell.

=IF(NOT(ISERROR(SEARCH("@",H4))),HYPERLINK("mailto:"&H4),
IF(NOT(ISERROR(SEARCH("@",I4))),HYPERLINK("mailto:"&I4),
IF(NOT(ISERROR(SEARCH("@",J4))),HYPERLINK("mailto:"&J4),"")))

HTH, my page on the above is sheets.htm
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Pages: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm