Extract all delimited values from column into their own cells in new column

[jlive24]

Hi everyone,

I have a spreadsheet containing email sender/recipient metadata (email from, to, cc, bcc) that I am attempting to normalize. Column A contains the email IDs, and column B contains the recipients values, delimited by semi-columns. Below is an example:

Column A (Email ID)	Column B (Recipient Values)
00001	Bob Smith [Bob.Smith@us.doodle.com];Brett Green [Brett.Green@gmail.com]
00002	Jane.Doe@yahoo.com; Rob Peters <Rob.Peters@slc.com> (Rob Peters@slc.com) [Rob.Peters@slc.com]
00004	TGARN9 <TGARN9@Bloomberg.net>; MIKEROC <MIKEROC10@Bloomberg.net>; Jeff.Hinger@gmail.com

I need a way to take the individual recipient values from Column A, and paste them into a new column so that each cell only contains 1 value, the goal being to have a single column with each individual recipient value. Normally I would just use Text to Columns to put each delimited value in a new column, then manually copy the values from each column into my new target column. However many of these emails contain over 100 recipients (in a few cases up to 800), so doing this manually is out of the question. Is there a formula or VBA solution that can look through each cell in column B, and extract each delimited value into its own cell in a new column, as shown below?

Unique Recipient Values
Bob Smith [Bob.Smith@us.doodle.com]
Brett Green [Brett.Green@gmail.com]
Jane.Doe@yahoo.com
Rob Peters <Rob.Peters@slc.com> (Rob Peters@slc.com) [Rob.Peters@slc.com]
TGARN9 <TGARN9@Bloomberg.net>
MIKEROC <MIKEROC10@Bloomberg.net>
Jeff.Hinger@gmail.com

 

[sandy666]

use Power Query with feature Split by delimiter to rows {this is one line only)

 

[mumps]

Change the sheet names to suit your needs. The result will be placed in Sheet2.

Sub SplitVals()
    Application.ScreenUpdating = False
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, rng As Range, splitRng As Variant, i As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In srcWS.Range("B2:B" & LastRow)
        splitRng = Split(rng, ";")
        For i = LBound(splitRng) To UBound(splitRng)
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1) = splitRng(i)
            End With
        Next i
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Cross posted Extract each delimited value from column A into its own cell in new column

While we do allow Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules). This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.