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

jlive24

New Member
Joined
Dec 18, 2018
Messages
5
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)
00001Bob Smith [Bob.Smith@us.doodle.com];Brett Green [Brett.Green@gmail.com]
00002Jane.Doe@yahoo.com; Rob Peters <Rob.Peters@slc.com> (Rob Peters@slc.com) [Rob.Peters@slc.com]
00004TGARN9 <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?

 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
use Power Query with feature Split by delimiter to rows {this is one line only)
 
Last edited:
Upvote 0
Change the sheet names to suit your needs. The result will be placed in Sheet2.
VBA Code:
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,223,884
Messages
6,175,175
Members
452,615
Latest member
bogeys2birdies

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
Back
Top