VBA to split delimited data in cell and duplicate row

D

dshafique

Board Regular
Joined
Jun 19, 2017
Messages
171
Hi everyone, I am hoping you guys can help me out with a roadblock I'm running into. I have this set of data, pretty linear, but one cell has multiple variables in it. I want to split the data in that cell, but duplicate everything else. Let me show you an example below:

ORIGINAL DATA
Delivery#ModifiedSCAC CodeDestinationDestination Sub NodeStatusAppointmentTotal Case Qty# of POCapacity Type
25269105​
28 Jan 2021, 01:04 PM (Central Standard Time)ROEV
6064​
Scheduled
1/30/2021​
2784​
0544085172 | 0544094338 | 0544092380 | 0544092341 |
Basic
80453253​
28 Jan 2021, 01:03 PM (Central Standard Time)ROEV
8307​
Scheduled
2/1/2021 15:00​
2400​
4572170915 | 3318916716 |Basic
25403457​
28 Jan 2021, 01:01 PM (Central Standard Time)COXS
7012​
Scheduled
2/2/2021 5:00​
6890​
2368508623 |Basic




DESIRED OUTCOME:
Delivery#ModifiedSCAC CodeDestinationDestination Sub NodeStatusAppointmentTotal Case Qty# of POCapacity Type
25269105​
28 Jan 2021, 01:04 PM (Central Standard Time)ROEV
6064​
Scheduled
1/30/2021​
2784​
0544085172Basic
2526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544094338Basic
2526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544092380Basic
2526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544092341Basic
80453253​
28 Jan 2021, 01:03 PM (Central Standard Time)ROEV
8307​
Scheduled
2/1/2021 15:00​
2400​
4572170915Basic
8045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024003318916716Basic
25403457​
28 Jan 2021, 01:01 PM (Central Standard Time)COXS
7012​
Scheduled
2/2/2021 5:00​
6890​
2368508623Basic

the data in column for #PO has all the numbers split by a "|" even for the last one,

any help would be greatly appreciated

thanks
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.
Sort by date Sort by votes
A Power query Solution. Mcode as follows

Power Query: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Delivery#", type text}, {"Modified", type text}, {"SCAC Code", type text}, {"Destination", type text}, {"Destination Sub Node", type any}, {"Status", type text}, {"Appointment", type text}, {"Total Case Qty", type text}, {"# of PO", type text}, {"Capacity Type", type text}}),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Changed Type", {{"# of PO", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "# of PO")
in
    #"Split Column by Delimiter"

Book3
ABCDEFGHIJ
1Delivery#ModifiedSCAC CodeDestinationDestination Sub NodeStatusAppointmentTotal Case Qty# of POCapacity Type
22526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544085172Basic
32526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544094338Basic
42526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544092380Basic
52526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/202127840544092341Basic
62526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784Basic
78045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024004572170915Basic
88045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024003318916716Basic
98045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:002400Basic
102540345728 Jan 2021, 01:01 PM (Central Standard Time)COXS7012Scheduled2/2/2021 5:0068902368508623Basic
112540345728 Jan 2021, 01:01 PM (Central Standard Time)COXS7012Scheduled2/2/2021 5:006890Basic
Table1
 
Upvote 0
Updated to delete rows with Blank PO

Power Query: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Delivery#", type text}, {"Modified", type text}, {"SCAC Code", type text}, {"Destination", type text}, {"Destination Sub Node", type any}, {"Status", type text}, {"Appointment", type text}, {"Total Case Qty", type text}, {"# of PO", type text}, {"Capacity Type", type text}}),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Changed Type", {{"# of PO", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "# of PO"),
    #"Filtered Rows" = Table.SelectRows(#"Split Column by Delimiter", each ([#"# of PO"] <> ""))
in
    #"Filtered Rows"
 
Upvote 0
This should do it.

Bug.xlsm
ABCDEFGHIJ
1Delivery#ModifiedSCAC CodeDestinationDestination Sub NodeStatusAppointmentTotal Case Qty# of POCapacity Type
22526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544085172Basic
32526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544094338Basic
42526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544092380Basic
52526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544092341Basic
68045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024004572170915Basic
78045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024003318916716Basic
82540345728 Jan 2021, 01:01 PM (Central Standard Time)COXS7012Scheduled2/2/2021 5:0068902368508623Basic
Sheet3


VBA Code: 
Sub UnWind()
Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row + 1
Dim r As Range: Set r = Range("A2:J" & LR)
Dim AR() As Variant: AR = r.Value2
Dim v As Variant
Dim SP() As String

r.ClearContents
With CreateObject("System.Collections.ArrayList")
    For i = LBound(AR) To UBound(AR)
        v = Application.Index(AR, i, 0)
        SP = Split(v(9), "|")
        For j = LBound(SP) To UBound(SP)
            If SP(j) <> vbNullString Then
                v(9) = Trim(SP(j))
                .Add v
            End If
        Next j
    Next i

    r.Cells(1, 1).Resize(.Count, 10).Value2 = Application.Transpose(Application.Transpose(.toArray))
End With

End Sub
 
Upvote 0
lrobbo314 said:
This should do it.

Bug.xlsm
ABCDEFGHIJ
1Delivery#ModifiedSCAC CodeDestinationDestination Sub NodeStatusAppointmentTotal Case Qty# of POCapacity Type
22526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544085172Basic
32526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544094338Basic
42526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544092380Basic
52526910528 Jan 2021, 01:04 PM (Central Standard Time)ROEV6064Scheduled1/30/20212784544092341Basic
68045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024004572170915Basic
78045325328 Jan 2021, 01:03 PM (Central Standard Time)ROEV8307Scheduled2/1/2021 15:0024003318916716Basic
82540345728 Jan 2021, 01:01 PM (Central Standard Time)COXS7012Scheduled2/2/2021 5:0068902368508623Basic
Sheet3


VBA Code: 
Sub UnWind()
Dim LR As Long: LR = Range("A" & Rows.Count).End(xlUp).Row + 1
Dim r As Range: Set r = Range("A2:J" & LR)
Dim AR() As Variant: AR = r.Value2
Dim v As Variant
Dim SP() As String

r.ClearContents
With CreateObject("System.Collections.ArrayList")
    For i = LBound(AR) To UBound(AR)
        v = Application.Index(AR, i, 0)
        SP = Split(v(9), "|")
        For j = LBound(SP) To UBound(SP)
            If SP(j) <> vbNullString Then
                v(9) = Trim(SP(j))
                .Add v
            End If
        Next j
    Next i

    r.Cells(1, 1).Resize(.Count, 10).Value2 = Application.Transpose(Application.Transpose(.toArray))
End With

End Sub
Click to expand...
hi, when I tried this, I got an error at the line "With CreateObject("System.Collections.ArrayList")" any ideas how to overcome that?

thanks
 
Upvote 0
You could try referencing the library and set the object using early binding.

https://excelmacromastery.com/vba-arraylist/

Early Binding​

Update 12-Nov-2019: Intellisense doesn’t currently work for the ArrayList.
Early binding allows use to use the Intellisense to see what is available to use. We must first add the type library as a reference and then select it from the reference list. We can use the following steps to do this:

  1. Select Tools and then References from the menu.
  2. Click on the Browse.
  3. Find the file mscorlib.tlb and click Open. It should be in a folder like this C:\Windows\Microsoft.NET\Framework\v4.0.30319.
  4. Scroll down the list and check mscorlib.dll.
  5. Click Ok.

You can now use the following code to declare the ArrayList using early binding:

Dim coll As New ArrayList
 
Upvote 0
alansidman said:
Updated to delete rows with Blank PO

Power Query: 
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Delivery#", type text}, {"Modified", type text}, {"SCAC Code", type text}, {"Destination", type text}, {"Destination Sub Node", type any}, {"Status", type text}, {"Appointment", type text}, {"Total Case Qty", type text}, {"# of PO", type text}, {"Capacity Type", type text}}),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Changed Type", {{"# of PO", Splitter.SplitTextByDelimiter("|", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "# of PO"),
    #"Filtered Rows" = Table.SelectRows(#"Split Column by Delimiter", each ([#"# of PO"] <> ""))
in
    #"Filtered Rows"
Click to expand...
hi, this looks like something that would help, especially since it will delete the blank rows. But we dont have access to power query, something about our excel version. do you know any workarounds?
thanks
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
Split a row into multiple rows based on a comma delimited string
Replies
5
Views
607
Peter_SSs
Peter_SSs
J
  • Question
VBA to Create Table and to Remove Duplicates
Replies
0
Views
675
jessebh2003
J
M
  • Solved
VBA Code to split week ranges into separate lines.
2
Replies
10
Views
2K
Joe4
Joe4
C
  • Question
combine or count data
2
Replies
15
Views
1K
navic
N
D
  • Question
Using VBA/Macros to Duplicate Sheets and Inserting Individual Rows from Table
Replies
2
Views
619
donnington
D

Forum statistics

Threads
1,214,920
Messages
6,122,272
Members
449,075
Latest member
staticfluids

Share this page

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