Separate cell contents and distribute to different rows

Question

I'm given the following sample data:

Item	Demand Qty	Comments
69-55179-78 MOD A	4	SHORT NAS1291C02M RCVD 09/14 COMMIT: 2 W/S 09/29 + 2 W/S 09/30

Which tells me that, of the required 4 units, 2 will ship 9/29 and 2 more will ship 9/30.

I'm attempting to split the row by unit to give a ship date for each piece. I've run the following code to split the line by quantity:

Sub ExpandRows()
    Dim dat As Variant
    Dim i As Long
    Dim rw As Range
    Dim rng As Range

    Set rng = ActiveSheet.UsedRange
    dat = rng
    On Error Resume Next
    For i = UBound(dat, 1) To 2 Step -1
        If dat(i, 3) > 1 Then
            Set rw = rng.Rows(i).EntireRow
            rw.Offset(1, 0).Resize(dat(i, 3) - 1).Insert
            rw.Copy rw.Offset(1, 0).Resize(dat(i, 3) - 1)
            rw.Cells(1, 3).Resize(dat(i, 3), 1) = 1
        End If
    Next
End Sub

So now I have this:

Item	Demand Qty	Comments
69-55179-78 MOD A	1	SHORT NAS1291C02M RCVD 09/14 COMMIT: 2 W/S 09/29 + 2 W/S 09/30
69-55179-78 MOD A	1	SHORT NAS1291C02M RCVD 09/14 COMMIT: 2 W/S 09/29 + 2 W/S 09/30
69-55179-78 MOD A	1	SHORT NAS1291C02M RCVD 09/14 COMMIT: 2 W/S 09/29 + 2 W/S 09/30
69-55179-78 MOD A	1	SHORT NAS1291C02M RCVD 09/14 COMMIT: 2 W/S 09/29 + 2 W/S 09/30

I need to distribute the dates from the comments column so that I'm left with this:

Item	Demand Qty	Comments
69-55179-78 MOD A	1	W/S 09/29
69-55179-78 MOD A	1	W/S 09/29
69-55179-78 MOD A	1	W/S 09/30
69-55179-78 MOD A	1	W/S 09/30

I've scoured forums and how-to's and haven't been able to find anything that fits this situation. The comments are different every time so I need to find the instances of "W/S" but I need the quantity before it and the date after and then insert a single date per row based on that quantity. I'm kind of at a loss as I've been staring at this for 2 days now. I know that the Stack isn't here to do it for me so I would consider an acceptable answer to be something that points me down a productive track.

EDIT Here is a larger subset of the data I'm working with:

Item	Demand Qty	Comments
115E5665G1	1
115E5684G1	1
115E6575G1 MOD A	3	1 W/S 09/21+ 1 W/S 09/22+ 1 W/S 09/23
115E6582G1 MOD A	2	1 W/S 09/15
115E6582G1 MOD A	2	1 W/S 09/19 + 1 W/S 09/20
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 1 W/S 09/21 + 1 W/S 09/22
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 1 W/S 09/23 + 1 W/S 09/26
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 1 W/S 09/27 + 1 W/S 09/28
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 2 W/S 09/29
115E6582G1 MOD A	1	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 1 W/S 09/30
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 2 W/S 10/03
115E6582G1 MOD A	2	SHORT:115E6716G12 : 14-SEP-22 QTY 77 ETA 9/17 COMMIT: 2 W/S 10/04

The comments come from an international sister facility so the formatting can be problematic. I appreciate all the responses so far. Just looking for that one that pushes me towards a working solution.

Cameron Critchlow · Answer

Wawooweewa, what a fun challenge! I really had to finish my coffee to figure out the dates part.

Option Explicit
Sub ReformatByLine()
    
    Dim I As Long               'Iteration Counter
    Dim N As Long               'Sub-Iteration Counter
    Dim X As Long               'Sub-Iteration Counter
    Dim DateCnt As Long         'Date Count
    Dim RowCnt As Long          'Row Count
    Dim OutCnt As Long          'OutArray Row Count
    Dim RG As Range             'Source Range
    Dim InArray()               'Data In Array
    Dim OutArray()              'Data Out Array
    Dim DateArray(1 To 50)      'Temp Array of Dates
    Dim DateString As String    'String Containing Dates
        
        ' >>> Collect data
    Set RG = Sheet1.Range("A4:C7")
    InArray = RG
    RowCnt = 0
    
        ' >>> Find expected upperbound of output array
    For I = 1 To UBound(InArray, 1)
        RowCnt = RowCnt + InArray(I, 2)
    Next I
    'Debug.Print RowCnt
    ReDim OutArray(1 To RowCnt, 1 To 4)
    
        ' >>> Begin data conversion
    OutCnt = 1
    For I = 1 To UBound(InArray, 1)
        
        ' > Extract date string from larger string
        DateString = Split(InArray(I, 3), ":")(1)
        DateString = Replace(DateString, " W/S ", "X")
        'Debug.Print DateString
        
        ' > Break apart dates
        If Len(DateString) = Len(Replace(DateString, "+", "")) Then
            For N = 1 To InArray(I, 2)
                DateArray(N) = Mid(DateString, InStr(1, DateString, "X", vbTextCompare) + 1, 50)
                'Debug.Print DateArray(N)
            Next N
        Else
            DateCnt = 1
            For N = 1 To UBound(Split(DateString, " + ")) + 1
                'Debug.Print "N=" & N
                'Debug.Print "For X = 1 to " & CInt(Split(Split(DateString, " + ")(N - 1), "X")(0))
                For X = 1 To CInt(Split(Split(DateString, " + ")(N - 1), "X")(0))
                    'Debug.Print "Date=" & Trim(Split(Split(DateString, " + ")(N - 1), "X")(1))
                    DateArray(DateCnt) = Trim(Split(Split(DateString, " + ")(N - 1), "X")(1))
                    DateCnt = DateCnt + 1
                Next X
            Next N
        End If
        
        ' > Build output array
        For N = 1 To InArray(I, 2)
            OutArray(OutCnt, 1) = InArray(I, 1)
            OutArray(OutCnt, 2) = 1
            OutArray(OutCnt, 3) = Split(InArray(I, 3), ":")(0)
            OutArray(OutCnt, 4) = DateArray(N)
            Debug.Print OutArray(OutCnt, 1) & " <> " & OutArray(OutCnt, 2) & " <> " & OutArray(OutCnt, 3) & " <> " & OutArray(OutCnt, 4)
            OutCnt = OutCnt + 1
        Next N
        
    Next I

    Sheet1.Range("E4").Resize(UBound(OutArray, 1), UBound(OutArray, 2)).Value = OutArray

End Sub

And here is the sheet I was working with. It shows both input and output. I'm kind of assuming the format will always be the same, but it's easy to fix with some more code if not.

findwindow · Answer

You can try mid and find like so.

For quantity:

=MID($C$2,FIND("W/S",$C$2,FIND("W/S",$C$2)+1)-2,2)

This would only work for quantities up to 99.

For date:

=MID(C2,FIND("W/S",C2,FIND("W/S",C2)+1)+3,6)

Ron Rosenfeld · Answer

I wasn't sure what you wanted to do if there was a mis-match between the W/S count and the Demand Qty.

The routine below will leave a blank comment for Items if there is insufficient W/S; or it will include a line with a blank Demand Qty if there are excessive W/S.

This can also be accomplished using Power Query, available in Windows Excel 2010+ and Excel 365 (Windows or Mac)

To use Power Query

Select some cell in your Data Table
Data => Get&Transform => from Table/Range or from within sheet
When the PQ Editor opens: Home => Advanced Editor
Make note of the Table Name in Line 2
Paste the M Code below in place of what you see
Change the Table name in line 2 back to what was generated originally.
Read the comments and explore the Applied Steps to understand the algorithm

M Code
Edited to work with latest data sample*

let

//Change next line to reflect actual data source
    Source = Excel.CurrentWorkbook(){[Name="Table10"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Item", type text}, {"Demand Qty", Int64.Type}, {"Comments", type text}}),

//Replace nulls with "" to deal with empty Comments section
    #"Replaced Value" = Table.ReplaceValue(#"Changed Type",null,"",Replacer.ReplaceValue,{"Comments"}),

//for grouping
    #"Added Index" = Table.AddIndexColumn(#"Replaced Value", "Index", 0, 1, Int64.Type),

//Group by Item and Index
//   One way of dealing with more or fewer W/S than Demand Qty
    #"Group by Item" = Table.Group(#"Added Index", {"Index","Item"},{
        {"new rows", (t)=> let
        //Create the expanded columns

        //Qty will always be 1
            Qty = List.Repeat({1}, t[Demand Qty]{0}),    

        //Create a List of the WS items by splitting on ":+ "
        //  and then retaining the items before and after an item that is W/S
            #"Split Comments" = List.Combine(List.Transform(t[Comments], each (Text.SplitAny(_,":+ ")))),

        //Positions of W/S
            WSpositions = List.PositionOf(#"Split Comments", "W/S", Occurrence.All),

        //Create a list of the Counts for each WS
            WScnts = List.Accumulate(WSpositions,{}, (state, current)=> state & {Number.From(#"Split Comments"{current-1})}),

        //Create a list of just the WS items
            WS = List.Accumulate(WSpositions,{}, (state,current)=> state & {Text.Combine(List.Range(#"Split Comments", current,2)," ")}),

        //Create a list of comments by duplicating each WS item Count times
            comments = 
                List.Combine(
                    List.Generate(
                        ()=>[c=List.Repeat({WS{0}}, WScnts{0}), idx=0],
                        each [idx] < List.Count(WS),
                        each [c=List.Repeat({WS{[idx]+1}}, WScnts{[idx]+1}), idx=[idx]+1],
                        each [c])),
//combine the Demand Qty and Comments columns into a new table
            results = Table.FromColumns(
                {Qty} & {comments}, 
                {"Demand Qty", "Commments"})       
        in
            results, type table[Demand Qty=Int64.Type, Commments=text]}
    }),
    #"Removed Columns" = Table.RemoveColumns(#"Group by Item",{"Index"}),
    #"Expanded new rows" = Table.ExpandTableColumn(#"Removed Columns", "new rows", {"Demand Qty", "Commments"})
in
    #"Expanded new rows"

Source

Results

Separate cell contents and distribute to different rows

3 Answers