VBA to Split and fill

[NeoSez]

I am trying to figure out how to separate column D into separate cells in the same column just below the current row.
So, 001 Street will have a new row just below this one.
002 Street will have a new row just below this one.
003 Street will have a new row just below this one.
etcera
It should copy the preceding information with it.

tiles	12x24	10	001 street 002 street 003 street 008 street 112 street 222 street 234 street 456 street 666 street 777 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

 

[Alex Blakenburg]

You seem to have lost all the lines in blue below:
Note: I will have to have a look at how to handle the formulas in T U X

Sub DataSplit_array()
    Dim sht As Worksheet
    Dim rng As Range
    Dim arrSrc As Variant, arrOut As Variant
    Dim lastRow As Long
    Dim splitCell As Variant
    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, 1), .Cells(lastRow, 19))  '<-- If there is a heading change it to .Cells(2,1)
        arrSrc = rng.Value
    End With
  
    ' Based on the nunber of Line Feeds get the count to dimension the output array
    For i = 1 To UBound(arrSrc)
        maxLines = maxLines + (Len(arrSrc(i, 19)) - Len(Replace(arrSrc(i, 19), vbLf, "")) + 1)
    Next i
  
    ReDim arrOut(1 To maxLines, 1 To UBound(arrSrc, 2))
  
    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, 19), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            rowOut = rowOut + 1
            For iCol = 1 To UBound(arrSrc, 2) - 1
                arrOut(rowOut, iCol) = arrSrc(i, iCol)
            Next iCol
            arrOut(rowOut, 19) = splitCell(j)
        Next j
    Next i
  
    rng.Resize(rowOut, UBound(arrOut, 2)).Value = arrOut
End Sub

 

[Alex Blakenburg]

This should be able to handle the formulas.

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)
        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

 

[NeoSez]

I failed to mention the data has a comma separating. Eg. 001 street,002 street,003 street,008 street,112 street,222 street,234 street,456 street,666 street,777 street

 

[Alex Blakenburg]

In your original example they were on separate lines which means a Line Feed separator. So what is the separator Line Feed or Comma or Both ?

 

[NeoSez]

In your original example they were on separate lines which means a Line Feed separator. So what is the separator Line Feed or Comma or Both ?

Hi Alex. In one workbook, it is comma separated. In another, it is Line feed. Will the script work on both?

 

[chingching831]

If you have a lot of data this might be quicker.
(PS: Have you considered using Power Query ?)

Sub DataSplit_array()
    Dim sht As Worksheet
    Dim rng As Range
    Dim arrSrc As Variant, arrOut As Variant
    Dim lastRow As Long
    Dim splitCell As Variant
    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(1, 1), .Cells(lastRow, 4))  '<-- If there is a heading change it to .Cells(2,1)
        arrSrc = rng.Value
    End With
  
    ' Based on the nunber of Line Feeds get the count to dimension the output array
    For i = 1 To UBound(arrSrc)
        maxLines = maxLines + (Len(arrSrc(i, 4)) - Len(Replace(arrSrc(i, 4), vbLf, "")) + 1)
    Next i
  
    ReDim arrOut(1 To maxLines, 1 To UBound(arrSrc, 2))
  
    For i = 1 To UBound(arrSrc)
        splitCell = Split(arrSrc(i, 4), vbLf)
        For j = LBound(splitCell) To UBound(splitCell)
            rowOut = rowOut + 1
            arrOut(rowOut, 1) = arrSrc(i, 1)
            arrOut(rowOut, 2) = arrSrc(i, 2)
            arrOut(rowOut, 3) = arrSrc(i, 3)
            arrOut(rowOut, 4) = splitCell(j)
        Next j
    Next i
  
    rng.Resize(rowOut, UBound(arrOut, 2)).Value = arrOut
End Sub

This is really nice! I have a similar question though... what if the street name is not split into new row, but a delimiter e.g. " , " ? How should I modify the VBA Code?

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

 

[Alex Blakenburg]

This is really nice! I have a similar question though... what if the street name is not split into new row, but a delimiter e.g. " , " ? How should I modify the VBA Code?

vbLf appears twice in the code, replace it with ", " (including the quotes and the space after the comma)

 

[Alex Blakenburg]

Hi Alex. In one workbook, it is comma separated. In another, it is Line feed. Will the script work on both?

Not without the modification below.
If it is reliably a comma and a space add the lines in blue to your code or replace that loop section in your code.

    ' 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

 

[NeoSez]

Not without the modification below.
If it is reliably a comma and a space add the lines in blue to your code or replace that loop section in your code.

    ' 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

Alex, thank you SO MUCH for all your guidance and help. Thank you, thank you, thank you!!!

 

[Alex Blakenburg]

You're welcome. Glad we could help.