Populate Rows & Columns by Comma Split

airforceone · Sep 5, 2024

Good day mate, need some advice here again

I would like to Populate Rows & Columns based on number of Comma Split
below code works for a single column, but would like to implement it to a couple of columns

VBA Code:

Sub Split_Seller_and_Buyer()
'   =====================
'          working
'   =====================

    Dim lastrow As Integer, i As Integer
    Dim descriptions() As String
    Dim Item As Variant
    
    With Worksheets("sht01")
        lastrow = .Range("C1").End(xlDown).Row
        For i = lastrow To 2 Step -1
            If InStr(1, .Range("C" & i).Value, ",") <> 0 Then
                descriptions = Split(.Range("C" & i).Value, ",")
            End If
            For Each Item In descriptions
                .Range("C" & i).Value = Item
                .Rows(i).Copy
                .Rows(i).Insert
            Next Item
            .Rows(i).EntireRow.Delete
    
        Next i
    End With
    
End Sub '   Split_Seller_and_Buyer

DATA SOURCE



Code	Seller	Buyer	Seller	Buyer
A0002	Robert Smith (18/Male/Hospitalized/Alien/STUDENT), Maria Garcia (43/Female/Hospitalized/Alien/FARMER)	Mary Smith (2/Male/Hospitalized/Alien/JOBLESS)	2	1
A0001	Gerald Golbuno (22/Male/Hospitalized/Alien/STUDENT)	Maria Hernandez (34/Female/Hospitalized/Alien/JOBLESS), James Johnson (40/Male/Hospitalized/Alien/JOBLESS), Maria Martinez (37/Female/Hospitalized/Alien/JOBLESS)	1	3

EXPECTED



Code	Seller	Buyer	Seller	Buyer
A0002	Robert Smith (18/Male/Hospitalized/Alien/STUDENT)	Mary Smith (2/Male/Hospitalized/Alien/JOBLESS)	2	1
A0002	Maria Garcia (43/Female/Hospitalized/Alien/FARMER)	Mary Smith (2/Male/Hospitalized/Alien/JOBLESS)	2	1
A0001	Gerald Golbuno (22/Male/Hospitalized/Alien/STUDENT)	Maria Hernandez (34/Female/Hospitalized/Alien/JOBLESS)	1	3
A0001	Gerald Golbuno (22/Male/Hospitalized/Alien/STUDENT)	James Johnson (40/Male/Hospitalized/Alien/JOBLESS)	1	3
A0001	Gerald Golbuno (22/Male/Hospitalized/Alien/STUDENT)	Maria Martinez (37/Female/Hospitalized/Alien/JOBLESS)	1	3

dermie_72 · Sep 6, 2024

you could try this. However you would need to select the text you're wanting to affect before running the macro. Otherwise it would be a matter of just checking the "C" in the code to whatever column you want.

VBA Code:

Sub Split_Seller_and_Buyer()
'   =====================
'          working
'   =====================

    Dim lastrow As Integer, I As Integer
    Dim descriptions() As String
    Dim Item As Variant
    
    With Worksheets("sht01")
        lastrow = Selection.Cells.count
        For I = lastrow To 1 Step -1
            
            If InStr(1, Selection.Cells(I).Value, ",") <> 0 Then
                descriptions = Split(Selection.Cells(I).Value, ",")
            End If

            For Each Item In descriptions
                Selection.Cells(I).Value = Item
                Selection.Cells(I).Copy
                Selection.Cells(I).Insert Shift:=xlDown
            Next Item
            Selection.Cells(I).EntireRow.Delete

        Next I
    End With
    
End Sub '   Split_Seller_and_Buyer

Also I noticed that if the r\cell does not have a comma, it will still do the last change, so Im assuming EVERY cell will have a comma?

Phuoc · Sep 6, 2024

Try this code:

VBA Code:

Option Explicit

Sub Split_Seller_and_Buyer()

    Dim lastrow&, i&, ii&, iii&, k&
    Dim dArr, rArr, Arr1, Arr2
    Dim U1&, U2&
    ReDim rArr(1 To 1000000, 1 To 4)
    
    With Worksheets("sht01")
        lastrow = .Range("C1").End(xlDown).Row
        dArr = .Range("C2:D" & lastrow).Value
        For i = 1 To UBound(dArr, 1)
            Arr1 = Split(dArr(i, 1), ",")
            Arr2 = Split(dArr(i, 2), ",")
            U1 = UBound(Arr1)
            U2 = UBound(Arr2)
            For ii = 0 To U1
                For iii = 0 To U2
                    k = k + 1
                    rArr(k, 1) = Arr1(ii)
                    rArr(k, 2) = Arr2(iii)
                    rArr(k, 3) = U1 + 1
                    rArr(k, 4) = U2 + 1
                Next iii
            Next ii
        Next i
    Range("C2").Resize(k, 4).Value = rArr
    End With
End Sub

airforceone · Sep 6, 2024

dermie_72 said:
you could try this. However you would need to select the text you're wanting to affect before running the macro. Otherwise it would be a matter of just checking the "C" in the code to whatever column you want.

VBA Code:

Sub Split_Seller_and_Buyer() ' ===================== ' working ' ===================== Dim lastrow As Integer, I As Integer Dim descriptions() As String Dim Item As Variant With Worksheets("sht01") lastrow = Selection.Cells.count For I = lastrow To 1 Step -1 If InStr(1, Selection.Cells(I).Value, ",") <> 0 Then descriptions = Split(Selection.Cells(I).Value, ",") End If For Each Item In descriptions Selection.Cells(I).Value = Item Selection.Cells(I).Copy Selection.Cells(I).Insert Shift:=xlDown Next Item Selection.Cells(I).EntireRow.Delete Next I End With End Sub ' Split_Seller_and_Buyer

Also I noticed that if the r\cell does not have a comma, it will still do the last change, so Im assuming EVERY cell will have a comma?

airforceone · Sep 6, 2024

Phuoc said:

Try this code:

VBA Code:

Option Explicit

Sub Split_Seller_and_Buyer()

    Dim lastrow&, i&, ii&, iii&, k&
    Dim dArr, rArr, Arr1, Arr2
    Dim U1&, U2&
    ReDim rArr(1 To 1000000, 1 To 4)
   
    With Worksheets("sht01")
        lastrow = .Range("C1").End(xlDown).Row
        dArr = .Range("C2:D" & lastrow).Value
        For i = 1 To UBound(dArr, 1)
            Arr1 = Split(dArr(i, 1), ",")
            Arr2 = Split(dArr(i, 2), ",")
            U1 = UBound(Arr1)
            U2 = UBound(Arr2)
            For ii = 0 To U1
                For iii = 0 To U2
                    k = k + 1
                    rArr(k, 1) = Arr1(ii)
                    rArr(k, 2) = Arr2(iii)
                    rArr(k, 3) = U1 + 1
                    rArr(k, 4) = U2 + 1
                Next iii
            Next ii
        Next i
    Range("C2").Resize(k, 4).Value = rArr
    End With
End Sub

does not meet the expected result mate

Phuoc · Sep 6, 2024

Try change to:

VBA Code:

Sub Split_Seller_and_Buyer_V2()

    Dim lastrow&, i&, ii&, iii&, k&
    Dim dArr, rArr, Arr1, Arr2
    Dim U1&, U2&
    ReDim rArr(1 To 1000000, 1 To 5)
    
    With Worksheets("sht01")
        lastrow = .Range("C1").End(xlDown).Row
        dArr = .Range("A2:E" & lastrow).Value
        For i = 1 To UBound(dArr, 1)
            Arr1 = Split(dArr(i, 2), ",")
            Arr2 = Split(dArr(i, 3), ",")
            U1 = UBound(Arr1)
            U2 = UBound(Arr2)
            For ii = 0 To U1
                For iii = 0 To U2
                    k = k + 1
                    rArr(k, 1) = dArr(i, 1)
                    rArr(k, 2) = Arr1(ii)
                    rArr(k, 3) = Arr2(iii)
                    rArr(k, 4) = dArr(i, 4)
                    rArr(k, 5) = dArr(i, 5)
                Next iii
            Next ii
        Next i
    Range("A2").Resize(k, 5).Value = rArr
    End With
End Sub

airforceone · Sep 6, 2024

Phuoc said:

Try change to:

VBA Code:

Sub Split_Seller_and_Buyer_V2()

    Dim lastrow&, i&, ii&, iii&, k&
    Dim dArr, rArr, Arr1, Arr2
    Dim U1&, U2&
    ReDim rArr(1 To 1000000, 1 To 5)
   
    With Worksheets("sht01")
        lastrow = .Range("C1").End(xlDown).Row
        dArr = .Range("A2:E" & lastrow).Value
        For i = 1 To UBound(dArr, 1)
            Arr1 = Split(dArr(i, 2), ",")
            Arr2 = Split(dArr(i, 3), ",")
            U1 = UBound(Arr1)
            U2 = UBound(Arr2)
            For ii = 0 To U1
                For iii = 0 To U2
                    k = k + 1
                    rArr(k, 1) = dArr(i, 1)
                    rArr(k, 2) = Arr1(ii)
                    rArr(k, 3) = Arr2(iii)
                    rArr(k, 4) = dArr(i, 4)
                    rArr(k, 5) = dArr(i, 5)
                Next iii
            Next ii
        Next i
    Range("A2").Resize(k, 5).Value = rArr
    End With
End Sub

that code seems to do the job just a quick query what does

VBA Code:

Dim lastrow&, i&, ii&, iii&, k&

means? what type is it?

Phuoc · Sep 6, 2024

Dim lastrow&, i&, ii&, iii&, k&

like this:

Dim lastrow as Long, i as Long, ii as Long, iii as Long, k as Long

airforceone · Monday at 11:58 PM

Phuoc said:
Dim lastrow&, i&, ii&, iii&, k&

like this:

Dim lastrow as Long, i as Long, ii as Long, iii as Long, k as Long

ok thanks mate... late reply due to typhoon

alansidman · Tuesday at 4:21 AM

An alternative to VBA with Power Query

Power Query:

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Split Column by Delimiter" = Table.ExpandListColumn(Table.TransformColumns(Source, {{"Seller", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Seller"),
    #"Split Column by Delimiter1" = Table.ExpandListColumn(Table.TransformColumns(#"Split Column by Delimiter", {{"Buyer", Splitter.SplitTextByDelimiter(",", QuoteStyle.Csv), let itemType = (type nullable text) meta [Serialized.Text = true] in type {itemType}}}), "Buyer")
in
    #"Split Column by Delimiter1"

Populate Rows & Columns by Comma Split

airforceone

Board Regular

Excel Facts

dermie_72

Well-known Member

Phuoc

Well-known Member

airforceone

Board Regular

airforceone

Board Regular

Phuoc

Well-known Member

airforceone

Board Regular

Phuoc

Well-known Member

airforceone

Board Regular

alansidman

Well-known Member

Similar threads

Forum statistics

Share this page

Populate Rows & Columns by Comma Split

Board Regular

Excel Facts

Well-known Member

Well-known Member

Board Regular

Board Regular

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock