VBA to split row duplicate rows based on entries in cell

[dshafique]

Hi Everyone, I am working with the results of a form, and cleaning up the answers. I have ran into a roadblock, and was hoping someone here can help me with this issue.
There are 2 fields which have potentially multiple entries and I would like to split those into different rows. for example:

Vendor 1

this is a test

Blue Box-Marketing;Mustard-Marketing;Classic Red-Marketing;

blue box - 234,000; Mustard - 345,000; Classic - 135,000;

the table above is a sample data, 3rd column has 3 entries and the 4th column also has 3 entries corresponding to the values in column 3. Is there a way to make this look like the table below?

Vendor 1	This is a test	Blue Box Marketing	234,000
Vendor 1	This is a test	Mustard Marketing	345,000
Vendor 1	This is a test	Classic	135,000

Is there a way to split the data dynamically, there could be 1 entry or 10. any help or guidance would be appreciated

thanks

 

[JLGWhiz]

See if this will work for you.

Sub tx()
Dim i As Long, spl As Variant, spt As Variant, j As Long
    With ActiveSheet
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            spl = Split(.Cells(i, 3).Value, ";")
            If UBound(spl) <> LBound(spl) Then
                spt = Split(.Cells(i, 4).Value, ";")
                .Cells(i + 1, 1).Resize(UBound(spl) - 1).EntireRow.Insert
                .Cells(i + 1, 1).Resize(UBound(spl) - 1, 2) = .Cells(i, 1).Resize(, 2).Value
                For j = LBound(spl) To UBound(spl) - 1
                    .Cells(i + j, 3) = spl(j)
                    .Cells(i + j, 4) = Mid(spt(j), InStr(spt(j), "-") + 1)
                Next
            Else
                If InStr(.Cells(i, 4), "-") > 0 Then
                    .Cells(i, 4) = Mid(.Cells(i, 4).Value, InStr(.Cells(i, 4).Value, "-") + 1)
                End If
            End If
        Next
    End With
End Sub

I stongly suggestyou test it on a copy of your file before applying it to your original.

 

[dshafique]

See if this will work for you.

Sub tx()
Dim i As Long, spl As Variant, spt As Variant, j As Long
    With ActiveSheet
        For i = .Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
            spl = Split(.Cells(i, 3).Value, ";")
            If UBound(spl) <> LBound(spl) Then
                spt = Split(.Cells(i, 4).Value, ";")
                .Cells(i + 1, 1).Resize(UBound(spl) - 1).EntireRow.Insert
                .Cells(i + 1, 1).Resize(UBound(spl) - 1, 2) = .Cells(i, 1).Resize(, 2).Value
                For j = LBound(spl) To UBound(spl) - 1
                    .Cells(i + j, 3) = spl(j)
                    .Cells(i + j, 4) = Mid(spt(j), InStr(spt(j), "-") + 1)
                Next
            Else
                If InStr(.Cells(i, 4), "-") > 0 Then
                    .Cells(i, 4) = Mid(.Cells(i, 4).Value, InStr(.Cells(i, 4).Value, "-") + 1)
                End If
            End If
        Next
    End With
End Sub

I stongly suggestyou test it on a copy of your file before applying it to your original.

Thank you so much, this pretty much what I needed. Is there a way for me to alter the columns that need to be split? like for instance if I need to do the splitting for columns 1,3 & 4?
Thanks

 

[JLGWhiz]

Is there a way for me to alter the columns that need to be split?

You control the columns with the Split function by designating it in the Cells(Row, Column) property.. I used two array variables(spl & spt) n the code above to distinguish between the different columns and you will note that the Cells property in each of those two functions is different. Maybe you can work with that info to do what you want. There is not a simple switch to throw on this one, it is dependent on what the option of the user.

 

[alansidman]

Here is an alternative solution using Power Query also referred to as Get & Transform. Here is the Mcode for that

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Added Custom" = Table.AddColumn(Source, "Custom", each Text.Split([Column3],";")),
    #"Added Custom1" = Table.AddColumn(#"Added Custom", "Custom.1", each Text.Split([Column4],";")),
    #"Added Custom2" = Table.AddColumn(#"Added Custom1", "Custom.2", each Table.FromColumns({[Custom],[Custom.1]})),
    #"Expanded Custom.2" = Table.ExpandTableColumn(#"Added Custom2", "Custom.2", {"Column1", "Column2"}, {"Custom.2.Column1", "Custom.2.Column2"}),
    #"Split Column by Delimiter" = Table.SplitColumn(#"Expanded Custom.2", "Custom.2.Column2", Splitter.SplitTextByDelimiter(" - ", QuoteStyle.Csv), {"Custom.2.Column2.1", "Custom.2.Column2.2"}),
    #"Changed Type" = Table.TransformColumnTypes(#"Split Column by Delimiter",{{"Custom.2.Column2.1", type text}, {"Custom.2.Column2.2", Int64.Type}}),
    #"Removed Other Columns" = Table.SelectColumns(#"Changed Type",{"Column1", "Column2", "Custom.2.Column1", "Custom.2.Column2.2"}),
    #"Filtered Rows" = Table.SelectRows(#"Removed Other Columns", each ([Custom.2.Column2.2] <> null))
in
    #"Filtered Rows"

Book7
	A	B	C	D	E	F	G
1	Column1	Column2	Column3	Column4
2	Vendor 1	this is a test	Blue Box-Marketing;Mustard-Marketing;Classic Red-Marketing;	blue box - 234,000; Mustard - 345,000; Classic - 135,000;
3
4
5	Column1	Column2	Custom.2.Column1	Custom.2.Column2.2
6	Vendor 1	this is a test	Blue Box-Marketing	234000
7	Vendor 1	this is a test	Mustard-Marketing	345000
8	Vendor 1	this is a test	Classic Red-Marketing	135000
Sheet1