extract email addresses from two column list

ajm · Nov 18, 2012

hi, i am trying to extract email addresses from a two column list. looks like the information may have been copied and pasted from a business card application of some sort. so first column contains name and a few other bits and pieces, the second column contains email address, phone numbers, status etc. unfortunately some records seem to be six lines, some seven. i thought i might try using a pivot to create a list of the account names and then do a lookup/offset combination formula but i cannot seem to work into it the means to locate the "@" in the email address (to identify which line contains the email address). my end result will be two columns: name and email address. or maybe, since the name is already on the first line of each record, i could use some sort of formula to pull the email address up the first line of column c??



<table border="1" bordercolor="#C0C0C0" bordercolordark="#FFFFFF" cellspacing="0" cellpadding="2">
<tr>
<td bgcolor="#FFFFFF" valign="bottom" style="white-space: nowrap">Celebrant</td>
<td bgcolor="#FFFFFF" valign="bottom" style="white-space: nowrap">Details</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">Abbey*Dayrell, Ms</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">12 Battunga Street, Wishart QLD 4122</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">Registered</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">p(H):*(07) 3349 3236*</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">13/01/2010</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">p(W):*(07) 3864 0221*</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">Active</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">m:*0414 359 154</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" align="right" valign="top" style="white-space: nowrap"></td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">abbeyd27@bigpond.com</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" align="right" valign="top" style="white-space: nowrap"></td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">Civil Ceremonies</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">Abbott*Timothy, Mr</td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">8 Warattah Court, Wurtulla QLD 4575</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" valign="middle" style="white-space: nowrap">Registered</td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">p(H):*(07) 5309 5070*</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" valign="middle" style="white-space: nowrap">26/02/2010</td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">p(W):*(07) 5440 2000*</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" valign="middle" style="white-space: nowrap">Active</td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">m:*0400 988 191</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" align="right" valign="top" style="white-space: nowrap"></td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">kerriabbott@optusnet.com.au</td>
</tr>
<tr>
<td bgcolor="#FCF8ED" align="right" valign="top" style="white-space: nowrap"></td>
<td bgcolor="#FCF8ED" valign="top" style="white-space: nowrap">Civil Ceremonies</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">Aberdeen*Leonie, Mrs</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">13 Lowanna Tce, Cleveland QLD 4163</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">Registered</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">p(H):*07 3821 0025*</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">2/09/2008</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">m:*0411 032 250</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" valign="middle" style="white-space: nowrap">Active</td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">leonie.aberdeen@bigpond.com</td>
</tr>
<tr>
<td bgcolor="#FFFFFF" align="right" valign="top" style="white-space: nowrap"></td>
<td bgcolor="#FFFFFF" valign="top" style="white-space: nowrap">Civil Ceremonies</td>
</tr>
</table>

ajm · Nov 20, 2012

Excel Workbook

A

B

C

2

Atwell*Julie-anne, Mrs

16 Phillips Street, Ebbw Vale QLD 4304

Example hyphenated first name

3

Registered

m:*0488 745 837

*

4

18/03/2010

jnsa7@hotmail.com

*

5

Active

Civil Ceremonies

*

6

Burton-nearhos*Jennifer, Mrs

Po Box 747, Capalaba QLD 4157

*

7

Registered

p(H):*07 3349 2023*

Example hyphenated last name

8

2/09/2008

f:*07 3245 7600*

*

9

Active

m:*0401 003 140

*

10

*

inharmony7@hotmail.com

*

11

*

Civil Ceremonies

*

12

Cooper*Elizabeth (libby), Ms

51 Beryl Crescent, Holland Park QLD 4121

*

13

Registered

p(H):*07 3394 3530*

Example preferred first name in brackets

14

29/10/2008

m:*0408 450 719

*

15

Active

libbyluis@optusnet.com.au

*

16

*

Civil Ceremonies

*

17

De Heus*Ingrid, Ms

Po Box 34, Point Lookout QLD 4183

Space in letters of last name

18

Registered

p(H):*07 3409 8352*

*

19

30/06/1995

Civil Ceremonies

*

20

Active

*

21

De Palma Day*Helen, Miss

Po Box 152, Yeppoon QLD 4703

2 Spaces in letters of last name

22

Registered

p(W):*0411 082 948*

*

23

4/06/2009

m:*0411 082 948

*

24

Active

barefootweddings@live.com

*

25

*

Civil Ceremonies

*

26

Dancing Free*Beth, Ms

Po Box 1105, Caloundra QLD 4551

Space in letters of last name

27

Registered

m:*0401 868 685

*

28

3/09/2005

beth@dancingfreecelebrant.com

*

29

Active

Civil Ceremonies

*

Sheet2

hiker95, maybe this will make it clearer. I have also included a description column (C) in the post here to show whether we are looking at a hyphenated surname, hyphenated first name, etc. Interestingly, when exceljeanie reproduces the data on screen, it inserts a "*" between the surname and firstname - and gets it right each time.

The most imprtant thing for me in the outputted material is that there is a name column (doesn't really matter if names appear as they do currently, or if they are put into First Name, Surname order) and an email column.

oh, QLD is a State: similar to Nevada, California, New Mexico, etc

hiker95 · Nov 20, 2012

ajm,

The format of some of the new raw data groups does not conform to the groups like the first set of data.

Sample raw data in worksheet Sheet1:

Excel Workbook

A

B

1

Celebrant

Details

2

Abbey*Dayrell, Ms

12 Battunga Street, Wishart QLD 4122

3

Registered

p(H):*(07) 3349 3236*

4

13/01/2010

p(W):*(07) 3864 0221*

5

Active

m:*0414 359 154

6

abbeyd27@bigpond.com

7

Civil Ceremonies

8

Abbott*Timothy, Mr

8 Warattah Court, Wurtulla QLD 4575

9

Registered

p(H):*(07) 5309 5070*

10

26/02/2010

p(W):*(07) 5440 2000*

11

Active

m:*0400 988 191

12

kerriabbott@optusnet.com.au

13

Civil Ceremonies

14

Aberdeen*Leonie, Mrs

13 Lowanna Tce, Cleveland QLD 4163

15

Registered

p(H):*07 3821 0025*

16

2/9/2008

m:*0411 032 250

17

Active

leonie.aberdeen@bigpond.com

18

Civil Ceremonies

19

Atwell*Julie-anne, Mrs

16 Phillips Street, Ebbw Vale QLD 4304

20

Registered

m:*0488 745 837

21

18/03/2010

jnsa7@hotmail.com

22

Active

Civil Ceremonies

23

Burton-nearhos*Jennifer, Mrs

Po Box 747, Capalaba QLD 4157

24

Registered

p(H):*07 3349 2023*

25

2/9/2008

f:*07 3245 7600*

26

Active

m:*0401 003 140

27

inharmony7@hotmail.com

28

Civil Ceremonies

29

Cooper*Elizabeth (libby), Ms

51 Beryl Crescent, Holland Park QLD 4121

30

Registered

p(H):*07 3394 3530*

31

29/10/2008

m:*0408 450 719

32

Active

libbyluis@optusnet.com.au

33

Civil Ceremonies

34

De Heus*Ingrid, Ms

Po Box 34, Point Lookout QLD 4183

35

Registered

p(H):*07 3409 8352*

36

30/06/1995

Civil Ceremonies

37

De Palma Day*Helen, Miss

Po Box 152, Yeppoon QLD 4703

38

Registered

p(W):*0411 082 948*

39

4/6/2009

m:*0411 082 948

40

Active

barefootweddings@live.com

41

Civil Ceremonies

42

Dancing Free*Beth, Ms

Po Box 1105, Caloundra QLD 4551

43

Registered

m:*0401 868 685

44

3/9/2005

beth@dancingfreecelebrant.com

45

Active

Civil Ceremonies

46

Sheet1

After the macro in a new worksheet Results:

Excel Workbook

A

B

C

D

E

F

G

H

I

J

K

L

M

1

Celebrant

Mr Ms Mrs

Registered

Date

Active

Street

City

?

Zip

p(H):

p(W):

m:

E-mail

2

Dayrell Abbey

Ms

Registered

13/01/2010

Active

12 Battunga Street

Wishart

QLD

4122

(07) 3349 3236

(07) 3864 0221

0414 359 154

abbeyd27@bigpond.com

3

Timothy Abbott

Mr

Registered

26/02/2010

Active

8 Warattah Court

Wurtulla

QLD

4575

(07) 5309 5070

(07) 5440 2000

0400 988 191

kerriabbott@optusnet.com.au

4

Leonie Aberdeen

Mrs

Registered

2/9/2008

Active

13 Lowanna Tce

Cleveland

QLD

4163

07 3821 0025

0411 032 250

leonie.aberdeen@bigpond.com

5

Julie-anne Atwell

Mrs

Registered

18/03/2010

Active

16 Phillips Street

Ebbw Vale

QLD

4304

0488 745 837

jnsa7@hotmail.com

6

Jennifer Burton-nearhos

Mrs

Registered

2/9/2008

Active

Po Box 747

Capalaba

QLD

4157

07 3349 2023

0401 003 140

inharmony7@hotmail.com

7

Elizabeth (libby) Cooper

Ms

Registered

29/10/2008

Active

51 Beryl Crescent

Holland Park

QLD

4121

07 3394 3530

0408 450 719

libbyluis@optusnet.com.au

8

Ingrid De Heus

Ms

Registered

30/06/1995

Active

Po Box 34

Point Lookout

QLD

4183

07 3409 8352

9

Helen De Palma Day

Miss

Registered

4/6/2009

Active

Po Box 152

Yeppoon

QLD

4703

0411 082 948

barefootweddings@live.com

10

Beth Dancing Free

Ms

Registered

3/9/2005

Active

Po Box 1105

Caloundra

QLD

4551

0401 868 685

beth@dancingfreecelebrant.com

11

Results

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Code:

Option Explicit
Sub ExtractDataV2()
' hiker95, 11/20/2012
' http://www.mrexcel.com/forum/excel-questions/670029-extract-email-addresses-two-column-list.html
Dim w1 As Worksheet, wR As Worksheet
Dim c As Range, firstaddress As String
Dim r As Long, lr As Long, nr As Long, sr As Long, er As Long
Dim Area As Range, s, t
Application.ScreenUpdating = False
Set w1 = Worksheets("Sheet1")
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
With wR.Cells(1, 1).Resize(, 13)
  .Value = [{"Celebrant","Mr Ms Mrs","Registered","Date","Active","Street","City","?","Zip","p(H):","p(W):","m:","E-mail"}]
  .Font.Bold = True
  .HorizontalAlignment = xlCenter
End With
With w1.Columns(2)
  Set c = .Find("Civil Ceremonies", LookIn:=xlValues, LookAt:=xlWhole)
  If Not c Is Nothing Then
    firstaddress = c.Address
    Do
      If w1.Range("B" & c.Row + 1) <> "" Then
        w1.Rows(c.Row + 1).Insert
      Else
        w1.Rows(c.Row + 2).Insert
      End If
      Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
  End If
End With
For Each Area In w1.Range("B2", w1.Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    sr = .Row
    er = sr + .Rows.Count - 1
    nr = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    s = Split(w1.Cells(sr, 1), ", ")
    wR.Cells(nr, 2) = s(1)
    t = Split(s(0), "*")
    wR.Cells(nr, 1) = t(1) & " " & t(0)
    wR.Cells(nr, 3).Resize(, 3).Value = Application.Transpose(w1.Range("A" & sr + 1 & ":A" & sr + 3).Value)
    For r = sr To er - 1 Step 1
      If InStr(w1.Cells(r, 2), ", ") > 0 Then
        s = Split(w1.Cells(r, 2), ", ")
        wR.Cells(nr, 6) = s(0)
        t = Split(s(1), " ")
        If UBound(t) = 2 Then
          wR.Cells(nr, 7).Resize(, 3).Value = t
        ElseIf UBound(t) = 3 Then
          wR.Cells(nr, 7).Value = t(0) & " " & t(1)
          wR.Cells(nr, 8).Value = t(2)
          wR.Cells(nr, 9).Value = t(3)
        ElseIf UBound(t) = 4 Then
          wR.Cells(nr, 7).Value = t(0) & " " & t(1) & " " & t(2)
          wR.Cells(nr, 8).Value = t(3)
          wR.Cells(nr, 9).Value = t(4)
        End If
      ElseIf InStr(w1.Cells(r, 2), "p(H):") > 0 Then
        s = Split(w1.Cells(r, 2), "*")
        wR.Cells(nr, 10) = s(1)
      ElseIf InStr(w1.Cells(r, 2), "p(W):") > 0 Then
        s = Split(w1.Cells(r, 2), "*")
        wR.Cells(nr, 11) = s(1)
      ElseIf InStr(w1.Cells(r, 2), "m:") > 0 Then
        s = Split(w1.Cells(r, 2), "*")
        wR.Cells(nr, 12) = s(1)
      ElseIf InStr(w1.Cells(r, 2), "@") > 0 Then
        wR.Cells(nr, 13) = w1.Cells(r, 2)
      End If
    Next r
  End With
Next Area
On Error Resume Next
w1.Range("B1", w1.Range("B" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
wR.Cells.EntireColumn.AutoFit
wR.Activate
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ExtractDataV2 macro.

ajm · Nov 20, 2012

Hiker95,m i still do not get past line "wR.Cells(nr, 1) = t(1) & " " & t(0)"

it appears that the "t" value is not being picked up. I will try again tonight to get on a computer at home to upload to box.net

BTW when it errors out, this is what the results page looks like:

Excel Workbook

A

B

C

D

E

F

G

H

I

J

K

L

M

1

Celebrant

Mr Ms Mrs

Registered

Date

Active

Street

City

?

Zip

p(H):

p(W):

m:

E-mail

2

*

Ms

*

Results

hiker95 · Nov 21, 2012

ajm,

What is the worksheet name containing the actual raw data?

I will need to see the actual workbook.

You can upload your workbook to Box Net,
sensitive data scrubbed/removed/changed
mark the workbook for sharing
and provide us with a link to your workbook.

ajm · Nov 21, 2012

Sheet1

hiker95 · Nov 21, 2012

ajm,

I will need to see the actual workbook.

You can upload your workbook to Box Net,
sensitive data scrubbed/removed/changed
mark the workbook for sharing
and provide us with a link to your workbook.

If you can not give us the workbook with the actual raw data worksheet, then:

Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.

ajm · Nov 22, 2012

hiker, your code is fine. I had a long think about it yesterday and tried a reverse engineer process. how would i go about trying to create a solution for someone else where they have provided existing data? I would copy their data into a new sheet and try to emulate their set up so that the result would be as close to what they required as possible. So, this started me thinking about what you were actually "seeing" when my data was posted. Turns out that Excel Jeanie adds the "*" that appears around each telephone number and inbetween the first and last names of each celebrant in the list. Your code relied on that * when splitting out the names into first name, last name order. My original data does not have asterisks where the bulletin board version does. So, to get around this splitting out the name error, i merely made

Code:

wR.Cells(nr, 1) = t(1) & " " & t(0)

into

Code:

wR.Cells(nr, 1) = w1.Cells(sr, 1)

. similarly with Phone Numbers, no * exists in the original work around each phone number. so I added an * and it all ran smoothly.

Thanks you for your patience and efforts in getting this one solved. I appreciate how frustrating it must be to see it work at your end and to be told its not working over here. Once again thanks.

hiker95 · Nov 22, 2012

ajm,

Thanks for the feedback.

You are very welcome. Glad I could help.

Come back anytime.

extract email addresses from two column list

ajm

Well-known Member

ajm

Well-known Member

Excel Facts

hiker95

Well-known Member

ajm

Well-known Member

hiker95

Well-known Member

ajm

Well-known Member

hiker95

Well-known Member

ajm

Well-known Member

hiker95

Well-known Member

Similar threads

Forum statistics

Share this page

extract email addresses from two column list

Well-known Member

Well-known Member

Excel Facts

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock