Split in row and auto insert row as per requirement

[Vishaal]

Hi, we have the following sheet where we want to split in row wise instead of column wise, can we do this from macro or any formula, its a large database

query sheet

S.No.	Code	Name	Price	Total	Qty
1	8185,7965,8175	General,hest254,tinkvol1	140,320,280	105,240,210	1,1,1
2	6594	jhset	140	105	1
3	7652,8795,8473,8265	rosey,randy-1,dom(vol1)(ed-1),Series test	320,280,140,295	240,210,105,221	1,1,1,1

required sheet

S.No.	Code	Name	Price	Total	Qty
1	8185	General	140	105	1
2	7965	hest254	320	240	1
3	8175	tinkvol1	280	210	1
4	6594	jhset	140	105	1
5	7652	rosey	320	240	1
6	8795	randy-1	280	210	1
7	8473	dom(vol-1)(ed-1)	140	105	1
8	8265	Series test	295	221	1

If there is no formula, kindly help with VBA please

 

[Osvaldo Palmeiro]

Hi. Try this code, please.
The code will put the result in sheet ReqSheet.
Change sheet names to suit.

Sub SplitIntoRows()
 Dim nxtRow As Long, vAllData As Variant, i As Long, m As Long
 Dim colB As Variant, colC As Variant, colD As Variant, colE As Variant, colF As Variant
  Application.ScreenUpdating = False
  vAllData = Sheets("QuerySheet").Range("B2:F" & Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row).Value2
  nxtRow = 2
  With Sheets("ReqSheet")
   .[A:F].Clear
   Sheets("QuerySheet").[A1:F1].Copy .[A1]
    For i = 1 To Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row - 1
     colB = Split(vAllData(i, 1), ",")
     colC = Split(vAllData(i, 2), ",")
     colD = Split(vAllData(i, 3), ",")
     colE = Split(vAllData(i, 4), ",")
     colF = Split(vAllData(i, 5), ",")
     For m = LBound(colB) To UBound(colB)
      .Cells(nxtRow, 2) = colB(m)
      .Cells(nxtRow, 3) = colC(m)
      .Cells(nxtRow, 4) = colD(m)
      .Cells(nxtRow, 5) = colE(m)
      .Cells(nxtRow, 6) = colF(m)
      nxtRow = nxtRow + 1
     Next m
    Next i
    .[A2] = 1: .Range("A2:A" & .Cells(Rows.Count, 2).End(3).Row).DataSeries , xlLinear
  End With
End Sub

 

[alansidman]

Here is an alternative solution employing Power Query

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Code", type text}, {"Name", type text}, {"Price", type text}, {"Total", type text}, {"10,", type text}}),
    #"Added Custom" = Table.AddColumn(#"Changed Type", "CODE.1", each Text.Split([Code],",")),
    #"Added Custom1" = Table.AddColumn(#"Added Custom", "NAME.1", each Text.Split([Name],",")),
    #"Added Custom2" = Table.AddColumn(#"Added Custom1", "PRICE.1", each Text.Split([Price],",")),
    #"Added Custom3" = Table.AddColumn(#"Added Custom2", "TOTAL.1", each Text.Split([Total],",")),
    #"Added Custom4" = Table.AddColumn(#"Added Custom3", "TEN", each Text.Split([#"10,"],",")),
    #"Removed Columns" = Table.RemoveColumns(#"Added Custom4",{"Code", "Name", "Price", "Total", "10,"}),
    #"Added Custom5" = Table.AddColumn(#"Removed Columns", "CustomX", each Table.FromColumns({[CODE.1],[NAME.1],[PRICE.1],[TOTAL.1],[TEN]})),
    #"Expanded CustomX" = Table.ExpandTableColumn(#"Added Custom5", "CustomX", {"Column1", "Column2", "Column3", "Column4", "Column5"}, {"Column1", "Column2", "Column3", "Column4", "Column5"}),
    #"Removed Other Columns" = Table.SelectColumns(#"Expanded CustomX",{"Column1", "Column2", "Column3", "Column4", "Column5"})
    
in
    #"Removed Other Columns"

Book4
	A	B	C	D	E	F
1	S.No	Code	Name	Price	Total	10,
2	1	8185,7965,8175	General, hest254,tinkvol1	140,320,280	105,240,210	1,1,1
3	2	6594	jhest	140	105	1
4	3	7652,8795,8473,8260	rosey, randy-1,dom(vol1)(ed-1), Series test	320 ,280,140,295	240,210,105,221	1,1,1,1
5
6
7	Column1	Column2	Column3	Column4	Column5
8	8185	General	140	105	1
9	7965	hest254	320	240	1
10	8175	tinkvol1	280	210	1
11	6594	jhest	140	105	1
12	7652	rosey	320	240	1
13	8795	randy-1	280	210	1
14	8473	dom(vol1)(ed-1)	140	105	1
15	8260	Series test	295	221	1
Sheet1

 

[Vishaal]

Thank you very much Osvaldo Palmeiro

 

[Vishaal]

Thanks alansidman

 

[Alex Blakenburg]

its a large database

I don't know how large you are talking but over 20k records the Power Query was much faster than the VBA.
Since you seem to want the VBA version, just modify Osvaldo's solution to use an array for the output and that will speed it up significanlty.

Sub SplitIntoRows_Osvaldo_mod()
    
    Dim nxtRow As Long, vAllData As Variant, i As Long, m As Long
    Dim colB As Variant, colC As Variant, colD As Variant, colE As Variant, colF As Variant
    Dim outarr()

    Application.ScreenUpdating = False
    
    vAllData = Sheets("QuerySheet").Range("B2:F" & Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row).Value2
    nxtRow = 1
    ReDim outarr(1 To 1000000, 1 To UBound(vAllData, 2) + 1)

    Sheets("ReqSheet").Columns("A:F").Clear
    Sheets("QuerySheet").Range("A1:F1").Copy Sheets("ReqSheet").Range("A1")
    For i = 1 To Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row - 1
        colB = Split(vAllData(i, 1), ",")
        colC = Split(vAllData(i, 2), ",")
        colD = Split(vAllData(i, 3), ",")
        colE = Split(vAllData(i, 4), ",")
        colF = Split(vAllData(i, 5), ",")
        For m = LBound(colB) To UBound(colB)
            outarr(nxtRow, 1) = nxtRow
            outarr(nxtRow, 2) = colB(m)
            outarr(nxtRow, 3) = colC(m)
            outarr(nxtRow, 4) = colD(m)
            outarr(nxtRow, 5) = colE(m)
            outarr(nxtRow, 6) = colF(m)
            nxtRow = nxtRow + 1
        Next m
    Next i
    
    Sheets("ReqSheet").Range("A2").Resize(nxtRow - 1, UBound(outarr, 2)) = outarr
    Application.ScreenUpdating = True
End Sub

 

[Vishaal]

getting run time error - 104

application defined or object defined error

Sheets("ReqSheet").Range("A2").Resize(nxtRow - 1, UBound(outarr, 2)) = outarr

 

[Vishaal]

Hi. Try this code, please.
The code will put the result in sheet ReqSheet.
Change sheet names to suit.

Sub SplitIntoRows()
 Dim nxtRow As Long, vAllData As Variant, i As Long, m As Long
 Dim colB As Variant, colC As Variant, colD As Variant, colE As Variant, colF As Variant
  Application.ScreenUpdating = False
  vAllData = Sheets("QuerySheet").Range("B2:F" & Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row).Value2
  nxtRow = 2
  With Sheets("ReqSheet")
   .[A:F].Clear
   Sheets("QuerySheet").[A1:F1].Copy .[A1]
    For i = 1 To Sheets("QuerySheet").Cells(Rows.Count, 1).End(3).Row - 1
     colB = Split(vAllData(i, 1), ",")
     colC = Split(vAllData(i, 2), ",")
     colD = Split(vAllData(i, 3), ",")
     colE = Split(vAllData(i, 4), ",")
     colF = Split(vAllData(i, 5), ",")
     For m = LBound(colB) To UBound(colB)
      .Cells(nxtRow, 2) = colB(m)
      .Cells(nxtRow, 3) = colC(m)
      .Cells(nxtRow, 4) = colD(m)
      .Cells(nxtRow, 5) = colE(m)
      .Cells(nxtRow, 6) = colF(m)
      nxtRow = nxtRow + 1
     Next m
    Next i
    .[A2] = 1: .Range("A2:A" & .Cells(Rows.Count, 2).End(3).Row).DataSeries , xlLinear
  End With
End Sub

only getting one data, dont know where is problem

 

[Alex Blakenburg]

I have logged for the night.
Things to check,
Is ReqSheet the correct sheet name ?
If you hover over nxtrow what no do you see ?
If you modified Osvaldo's code please post the exact code you had working and I will have a look tomorrow.
(How many rows in your data ?)

 

[Vishaal]

I have logged for the night.
Things to check,
Is ReqSheet the correct sheet name ?
If you hover over nxtrow what no do you see ?
If you modified Osvaldo's code please post the exact code you had working and I will have a look tomorrow.
(How many rows in your data ?)

Sheet name same
code is not modified
row 4294
using everything same