I'm given the following sample data:

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:

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

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.

CodePudding user response：

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)

CodePudding user response：

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.