Email address question

slyporter

New Member
Joined
Jun 23, 2015
Messages
1
I have an excel sheet with multiple email addresses in each cell in one column. Some cells have no addresses, others have many, each cell is different. The email addresses are semicolon delimited, so it's easy to do Text to Columns to extract the individual email addresses into separate columns. However, I'd like to get all of the emails listed one by one in one column vs. spread out across multiple columns. Any help would be much appreciated.

Here's an example of the data for one column
cell 1: xxx@xx.com; xxy@xx.com; xxz@xx.com
cell 2: blank
cell 3: xxa@xx.com; xxb@xx.com
cell 4: xxc@xx.com; xxd@xx.com; xxe@xx.com; xxf@xx.com; xxg@xx.com

I'd like to end up with (all in one column):
xxx@xx.com
xxy@xx.com
xxz@xx.com
xxa@xx.com
xxb@xx.com
xxc@xx.com
xxd@xx.com
xxe@xx.com
xxf@xx.com
xxg@xx.com

Thanks!
-Scott
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Momentman

Well-known Member
Joined
Jan 11, 2012
Messages
4,142
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Here's the data, raw and edited(in colummn B)

Excel 2013
AB
1xxx@xx.com; [email]xxy@xx.com[/email]; [email]xxz@xx.com[/email]xxx@xx.com
2xxy@xx.com
3xxa@xx.com; [email]xxb@xx.com[/email]xxz@xx.com
4xxc@xx.com; [email]xxd@xx.com[/email]; [email]xxe@xx.com[/email]; [email]xxf@xx.com[/email]; [email]xxg@xx.com[/email]xxa@xx.com
5trialxxb@xx.com
6xxc@xx.com; [email]xxd@xx.com[/email]; [email]xxe@xx.com[/email]; [email]xxf@xx.com[/email]; [email]xxg@xx.com[/email]xxc@xx.com
7xxd@xx.com
8xxe@xx.com
9xxf@xx.com
10xxg@xx.com
11xxc@xx.com
12xxd@xx.com
13xxe@xx.com
14xxf@xx.com
15xxg@xx.com
Sheet28


and here is the code
Code:
Sub SplitData()
    Dim I As Integer
    Dim j As Integer
    Dim ask
    Dim k As Integer
    
    k = 1
    For I = 1 To Range("A" & Rows.Count).End(xlUp).Row
        If Cells(I, 1).Value = "" Or Not InStr(1, Cells(I, 1).Value, "@") > 0 Then
            GoTo skiplab
        Else
            ask = Split(Cells(I, 1).Value, ";")
            For j = LBound(ask) To UBound(ask)
                Range("B" & k).Value = Trim(ask(j))
                k = k + 1
            Next j
        End If
skiplab:
    Next I
End Sub
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,164,657
Messages
5,838,635
Members
430,558
Latest member
Krampus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top