• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Split Data into multiple rows with other column data intact

uday

Member
Hi,

I am trying to split the data into multiple rows in Sheet1. But EXCEL vba is not working in "SPLIT" function. It is stopping there and not going to the next line of code. I have provided desired output data in Output tab. Please see the attached file.

Thanks & Regards,
Uday
 

Attachments

  • Book1.xlsb
    14.8 KB · Views: 8
Call your sub anything but Split!
(It's getting confused between your sub Split and the Split function.)
 
An alternative solution is to employ Power Query, also called Get and Transform in 2016 and later. Found on the Data Tab.

Code:
let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"Location", type text}, {"Item", type text}, {"type", type text}, {"price", Int64.Type}}),
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(#"Changed Type", {{"Item", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Item"),
    #"Changed Type1" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Item", type text}})
in
    #"Changed Type1"

Excel 2016 (Windows) 32 bit
A
B
C
D
1
LocationItemtypeprice
2
INDIAAFruit
40​
3
INDIABFruit
40​
4
INDIACFruit
40​
5
USDMetal
100​
6
USEMetal
100​
7
UKAWater
15​
Sheet: Table1
 
Please try

Code:
Sub sp()
    Dim l As Long, i As Long, it, ar
    ReDim ar(1 To 4, 1)
    For r = 2 To Sheets("Sheet1").Range("B999999").End(xlUp).Row
        For Each it In split(Cells(r, 2), ",")
            i = i + 1
            ReDim Preserve ar(1 To 4, 1 To i)
            ar(1, i) = Cells(r, 1)
            ar(2, i) = it
            ar(3, i) = Cells(r, 3)
            ar(4, i) = Cells(r, 4)
        Next
    Next
    [a2].Resize(UBound(ar, 2), 4) = Application.Transpose(ar)
End Sub
 
Back
Top