Find email addresses in column B and copy them to column C sequentially.

[MikeBerlan]

I have approximately 1800 agent data files in column B and need to sequentially copy the email addresses into column C. Note: the cell including the email address...E-Mail: jack@abcrealty.com[/B]...etc do not fall on every 8th row because each data file is different. Can someone help with an Excel Formula that can solve my problem?

Column B Column C
Example: John Smith jack@abcrealty.com
ABC Realty nancy@abcrealty.com
123 Adams Street
Jacksonville, FL 01234
Agent
Cell Phone: 123-45-6789
Home Phone: 123-45-6789
Website: www.sellingyourhome.com
E-mail: jack@abcrealty.com

Nancy Smith
ABC Realty
123 Eve Street
Jacksonville, FL 01234
Broker
Cell Phone: 123-45-6789
E-mail: nancy@abcrealty.com

 

[FDibbins]

You probably want to extract just the email addy, but this us a start, using a helper column...

	B​	C​	D​	E​
2​	John Smith jack@abcrealty.com	1​		John Smith jack@abcrealty.com
3​	ABC Realty nancy@abcrealty.com	2​		ABC Realty nancy@abcrealty.com
4​	123 Adams Street	2​		E-mail: jack@abcrealty.com
5​	Jacksonville, FL 01234	2​		E-mail: nancy@abcrealty.com
6​	Agent	2​
7​	Cell Phone: 123-45-6789	2​
8​	Home Phone: 123-45-6789	2​
9​	Website: www.sellingyourhome.com	2​
10​	E-mail: jack@abcrealty.com	3​
11​		3​
12​	Nancy Smith	3​
13​	ABC Realty	3​
14​	123 Eve Street	3​
15​	Jacksonville, FL 01234	3​
16​	Broker	3​
17​	Cell Phone: 123-45-6789	3​
18​	E-mail: nancy@abcrealty.com	4​

C2=IF(ISNUMBER(FIND("@",B2)),C1+1,C1)
copied down

E2=IFERROR(INDEX(B:B,MATCH(ROWS($1:1),$C:$C,0)),"")
copied down

 

[tonyyy]

You could also try the following in C1, copied down...

=TRIM(RIGHT(SUBSTITUTE(IFERROR(IF(FIND("@",B1)>0,B1,""),"")," ",REPT(" ",LEN(IFERROR(IF(FIND("@",B1)>0,B1,""),"")))),LEN(IFERROR(IF(FIND("@",B1)>0,B1,""),""))))

Cheers,

tonyyy

 

[MikeBerlan]

	Column A	Column B
1	John Smith	jack@abcrealty.com
2	ABC Realty	nancy@abcrealty.com
3	123 Adams Street
4	Jacksonville, FL 01234
5	Agent
6	Cell Phone: 123-45-6789
7	Home Phone: 123-45-6789
8	Website: www.sellingyourhome.com
9	E-mail: jack@abcrealty.com
10
11
12	Nancy Smith
13	ABC Realty
14	123 Eve Street
15	Jacksonville, FL 01234
16	Broker
17	Cell Phone: 123-45-6789
18	E-mail: nancy@abcrealty.com

<tbody>
</tbody>

I am very sorry that I confused the problem because I did not use a table to begin with. I caused you extra time and confusion! This table should clearly show what formula I need to populate the email addresses in column B.

Thank you,
Mike

 

[yky]

Sub test()
Dim row_C As Integer
Dim rng1 As Range
Dim cell As Range

Set rng1 = Range("A1:A" & ThisWorkbook.Sheets(1).UsedRange.Rows.Count)
row_C = 1

For Each cell In rng1

If cell.Value Like "*@*" Then
ThisWorkbook.Sheets(1).Cells(row_C, 3) = Right(cell, Len(cell.Value) - InStr(cell.Value, ":") - 1)
row_C = row_C + 1
End If
Next cell

End Sub

 

[T. Valko]

Try this...

Data Range

	A​	B​	C​
1​	John Smith​	------​	jack@abcrealty.com​
2​	ABC Realty​		nancy@abcrealty.com​
3​	123 Adams Street​
4​	Jacksonville, FL 01234​
5​	Agent​
6​	Cell Phone: 123-45-6789​
7​	Home Phone: 123-45-6789​
8​	Website: www.sellingyourhome.com​
9​	E-mail: jack@abcrealty.com​
10​
11​
12​	Nancy Smith​
13​	ABC Realty​
14​	123 Eve Street​
15​	Jacksonville, FL 01234​
16​	Broker​
17​	Cell Phone: 123-45-6789​
18​	E-mail: nancy@abcrealty.com​

This array formula** entered in C1:

=IFERROR(SUBSTITUTE(INDEX(A:A,SMALL(IF(ISNUMBER(FIND("@",A$1:A$18)),ROW(A$1:A$18)),ROWS(C$1:C1))),"E-mail: ",""),"")

** array formulas need to be entered using the key
combination of CTRL,SHIFT,ENTER (not just ENTER).
Hold down both the CTRL key and the SHIFT key
then hit ENTER.

Copy down until you get blanks.

 

[MikeBerlan]

Thank you very much! Have a great evening.

 

[Macropod]

MikeBerlan,

As per Board Rule #12 (http://www.mrexcel.com/forum/board-announcements/99490-forum-rules.html) please don't create duplicate threads.

I have now merged your two threads on this topic.

 

[Peter_SSs]

In case you are interested, you could also do this manually fairly quickly

1. AutoFilter column A for "Begins with" -> "E-mail"
2. Select column A excluding the first row and Copy
3. Remove the Filter from the column.
4. Select cell B2 and Paste
5. With the pasted cells still selected do a Find/Replace with Find what: *:? -> Replace with: leave blank -> Options: ensure 'Match entire cell contents' is not checked -> Replace All

 

[Rick Rothstein]

If you are looking for a VBA solution, then give this macro a try...

[table="width: 500"]
[tr]
	[td]Sub GetEmailAddresses()
  Dim X As Long, LastRow As Long, Email As Variant, Result As Variant
  ActiveSheet.AutoFilterMode = False
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  ReDim Result(1 To LastRow, 1 To 1)
  Range("B1:B" & LastRow).AutoFilter Field:=1, Criteria1:="=E-mail:*"
  For Each Email In Sheet1.AutoFilter.Range.Offset(1).Resize(LastRow - 1).SpecialCells(xlVisible)
    X = X + 1
    Result(X, 1) = Mid(Email, InStrRev(Email, " ") + 1)
  Next
  Range("B1:B" & LastRow).AutoFilter
  Range("C1").Resize(UBound(Result)) = Result
End Sub[/td]
[/tr]
[/table]