VBA Split and Fill only doing one line at a time. Help.

[NeoSez]

Alex Blakenburg graciously helped me with the VBA code. Thank you.​

• I don't understand what the vbLf is or how to fix it in the sheet.
• Original looks like this:
  

  tiles	12x24	10	001 street, 002 street, 003 street
  ladders	30'	2	898 street, 929 street
  doors	35x88	3	555 street, 666 street, 777 street

  The new chart will look something like this:
  I hope this all makes sense.
  

  tiles	12x24	10	001 street
  tiles	12x24	10	002 street
  tiles	12x24	10	003 street

  
  
  I do not want any blank lines, so I commented it out. Why is it stopping only after one line splitting?

    Sub DataSplit_array_formulas()
    Dim sht As Worksheet
    Dim rng As Range
    Dim arrSrc As Variant, arrOut As Variant
    Dim lastRow As Long
    Dim splitCell As Variant, splitColNo As Long
    Dim maxLines As Long
    Dim i As Long, j As Long, iCol As Long, rowOut As Long
  
    Set sht = Worksheets("Sheet1")                          '<-- Change the sheet name to whatever you need it to be
    With sht
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
        Set rng = .Range(.Cells(4, "A"), .Cells(lastRow, "Z"))
        splitColNo = 19
        arrSrc = rng.FormulaR1C1
    End With
  
    ' Based on the nunber of Line Feeds get the count to dimension the output array
    For i = 1 To UBound(arrSrc)
    
    ' If delimiter is comma+space convert it to vbLF to standardise the delimiter.
        arrSrc(i, splitColNo) = Replace(arrSrc(i, splitColNo), ", ", vbLf)
        maxLines = maxLines + (Len(arrSrc(i, splitColNo)) - Len(Replace(arrSrc(i, splitColNo), vbLf, "")) + 1)
        
    Next i
  
    ReDim arrOut(1 To maxLines, 1 To UBound(arrSrc, 2))
  
    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, splitColNo), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            rowOut = rowOut + 1
            For iCol = 1 To UBound(arrSrc, 2)
                arrOut(rowOut, iCol) = arrSrc(i, iCol)          ' should skip column 19 but it will get overwritten anyway
            Next iCol
            arrOut(rowOut, splitColNo) = splitCell(j)
        Next j
    Next i
  
    'rng.Resize(rowOut, UBound(arrOut, 2)).FormulaR1C1 = arrOut
End Sub

 

[Alex Blakenburg]

I don't understand what the vbLf is or how to fix it in the sheet.

From memory your data in Column 19 (S) had a line feed character in it and that signified that you wanted it in a new cell but with all the row data associated with it.
To complicate matters some of the items to be split out were separated by a ", ".
vbLf = Line Feed
Manually in a cell you can enter that using Alt+<Enter>

I do not want any blank lines, so I commented it out. Why is it stopping only after one line splitting?

Since it relied on the Line Feed to split the cell commenting it out means it doesn't split.
If you are getting blank lines try adding the lines in blue that I have below:

    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, splitColNo), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            If Trim(splitCell(j)) <> "" Then
                rowOut = rowOut + 1
                For iCol = 1 To UBound(arrSrc, 2)
                    arrOut(rowOut, iCol) = arrSrc(i, iCol)          ' should skip column 19 but it will get overwritten anyway
                Next iCol
                arrOut(rowOut, splitColNo) = splitCell(j)
            End If
        Next j
    Next i

 

[NeoSez]

From memory your data in Column 19 (S) had a line feed character in it and that signified that you wanted it in a new cell but with all the row data associated with it.
To complicate matters some of the items to be split out were separated by a ", ".
vbLf = Line Feed
Manually in a cell you can enter that using Alt+<Enter>

Since it relied on the Line Feed to split the cell commenting it out means it doesn't split.
If you are getting blank lines try adding the lines in blue that I have below:

    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, splitColNo), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            If Trim(splitCell(j)) <> "" Then
                rowOut = rowOut + 1
                For iCol = 1 To UBound(arrSrc, 2)
                    arrOut(rowOut, iCol) = arrSrc(i, iCol)          ' should skip column 19 but it will get overwritten anyway
                Next iCol
                arrOut(rowOut, splitColNo) = splitCell(j)
            End If
        Next j
    Next i

Thank you for the suggestion.
Your script worked perfectly for the other batch of files I had. I think it may be this workbook that has issues. It will only run the first row and split the data, BUT overwrites all the other original rows below it, then stops. I just went through the sheet and noticed that the original data was being overwritten after the split.
Not sure what else I can do to this sheet. I have stripped all the formatting from the sheet, copied it and paste-special the data to a brand new sheet and it still over writes the original rows below when splitting the data,
Has this happened to anyone before?