Extract multiple instance of data from within parentheses, display on individual lines,

Arialvetica

New Member
Joined
Sep 10, 2022
Messages
1
Office Version
  1. 2013
Platform
  1. Windows
I have a set of data that is formatted one way (including multiple items in a single cell), and I want to extract that data and display it a different way (each item in its own cell, in a column). The data is always changing, so I am looking for a formula that will auto-update as new rows are added to the table, or old rows are removed. The largest number of items in a single cell at this time is 4, but I'd like to err on the side of caution and allow for 6 entries in a single cell.

The final version of this file will be saved and shared as a Google Sheet, if that is relevant.

Book1
ABCDEF
1Data I'm starting withDesired Output
2AlphaAndrew (Jan 1950), Ben (Feb 1951), Chris (Mar 1952)AlphaAndrew1/1/1950
3BravoDavid (Apr 1953), Eric (May 1954), Fred (Apr 1955), George (May 1956), Henry (June 1957), Iggy (July 1958)AlphaBen2/1/1951
4CharlieJerome (Aug 1959), Kirk (Sept 1960)AlphaChris3/1/1952
5DeltaLawrence (Oct 1959), Mark (Nov 1960)BravoDavid4/1/1953
6EchoNorman (Dec 1961)BravoEric5/1/1954
7BravoFred4/1/1955
8BravoGeorge5/1/1956
9BravoHenry6/1/1957
10BravoIggy7/1/1958
11CharlieJerome8/1/1959
12CharlieKirk9/1/1960
13DeltaLawrence10/1/1959
14DeltaMark11/1/1960
15EchoNorman12/1/1961
Sheet1
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Try this macro. The result will be placed in Sheet2. Change the sheet names (in red) to suit your needs. Before you run the macro, format column C in Sheet2 to "m/d/yyyy".
Rich (BB code):
Sub SplitData()
    Application.ScreenUpdating = False
    Dim rng As Range, v As Variant, srcWS As Worksheet, desWS As Worksheet, i As Long, mNum As Long, y As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Sheet2")
    With srcWS
        For Each rng In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
            v = Split(rng.Offset(, 1), ",")
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(v) + 1) = rng
                For i = LBound(v) To UBound(v)
                    mNum = DatePart("M", Left(Split(v(i), "(")(1), 3) & "/01/2022")
                    y = Left(Right(v(i), 5), 4)
                    .Cells(.Rows.Count, "B").End(xlUp).Offset(1).Resize(, 2).Value = Array(Split(v(i), "(")(0), DateSerial(y, mNum, 1))
                Next i
            End With
        Next rng
    End With
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here is a solution using Power Query (if you're not familiar with Power Query, this article might help: Power Query Basics):

Power Query:
let
    Source = Excel.CurrentWorkbook(){[Name="Table9"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"A", type text}, {"B", type text}}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Changed Type", "B", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), {"B.1", "B.2", "B.3", "B.4", "B.5", "B.6"}),
    #"Trimmed Text" = Table.TransformColumns(#"Split Column by Delimiter",{{"B.1", Text.Trim, type text}, {"B.2", Text.Trim, type text}, {"B.3", Text.Trim, type text}, {"B.4", Text.Trim, type text}, {"B.5", Text.Trim, type text}, {"B.6", Text.Trim, type text}}),
    #"Transposed Table" = Table.Transpose(#"Trimmed Text"),
    #"Promoted Headers" = Table.PromoteHeaders(#"Transposed Table", [PromoteAllScalars=true]),
    #"Changed Type1" = Table.TransformColumnTypes(#"Promoted Headers",{{"Alpha", type text}, {"Bravo", type text}, {"Charlie", type text}, {"Delta", type text}, {"Echo", type text}}),
    #"Unpivoted Columns" = Table.UnpivotOtherColumns(#"Changed Type1", {}, "Attribute", "Value"),
    #"Split Column by Delimiter1" = Table.SplitColumn(#"Unpivoted Columns", "Value", Splitter.SplitTextByEachDelimiter({" ("}, QuoteStyle.Csv, false), {"Value.1", "Value.2"}),
    #"Changed Type2" = Table.TransformColumnTypes(#"Split Column by Delimiter1",{{"Value.1", type text}, {"Value.2", type text}}),
    #"Extracted Text Before Delimiter" = Table.TransformColumns(#"Changed Type2", {{"Value.2", each Text.BeforeDelimiter(_, ")"), type text}}),
    #"Trimmed Text1" = Table.TransformColumns(#"Extracted Text Before Delimiter",{{"Value.2", Text.Trim, type text}}),
    #"Replaced Value" = Table.ReplaceValue(#"Trimmed Text1","Sept","Sep",Replacer.ReplaceText,{"Value.2"}),
    #"Changed Type3" = Table.TransformColumnTypes(#"Replaced Value",{{"Value.2", type date}}),
    #"Renamed Columns" = Table.RenameColumns(#"Changed Type3",{{"Value.1", "Name"}, {"Value.2", "Date"}}),
    #"Sorted Rows" = Table.Sort(#"Renamed Columns",{{"Attribute", Order.Ascending}})
in
    #"Sorted Rows"

Screenshot 2022-09-10 102419.png
 
Upvote 0
How about

VBA Code:
Sub jecc()
 Dim ar, it, i As Long, x As Long
 ReDim sq(2, 0)
 ar = Cells(2, 1).CurrentRegion
 
 For i = 2 To UBound(ar)
   For Each it In Split(ar(i, 2), ", ")
      ReDim Preserve sq(2, x)
      sq(0, x) = ar(i, 1)
      sq(1, x) = Left(it, InStr(it, "(") - 1)
      sq(2, x) = Replace(Split(Left(it, Len(it) - 1), "(")(1), " ", "-1-")
      x = x + 1
   Next
 Next
     
 Range("H2").Resize(x, 3) = Application.Transpose(sq)
End Sub
 
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