VBA to split row duplicate rows based on entries in cell

dshafique

Board Regular
Joined
Jun 19, 2017
Messages
165
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 1this is a testBlue 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 1This is a testBlue Box Marketing234,000
Vendor 1This is a testMustard Marketing345,000
Vendor 1This is a testClassic135,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
 

Some videos you may like

Excel Facts

What is =ROMAN(40) in Excel?
The Roman numeral for 40 is XL. Bill "MrExcel" Jelen's 40th book was called MrExcel XL.

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
See if this will work for you.

VBA Code:
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.
 
Solution

dshafique

Board Regular
Joined
Jun 19, 2017
Messages
165
See if this will work for you.

VBA Code:
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

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
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

Well-known Member
Joined
Feb 26, 2007
Messages
6,060
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Here is an alternative solution using Power Query also referred to as Get & Transform. Here is the Mcode for that

Power Query:
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
ABCDEFG
1Column1Column2Column3Column4
2Vendor 1this is a testBlue Box-Marketing;Mustard-Marketing;Classic Red-Marketing;blue box - 234,000; Mustard - 345,000; Classic - 135,000;
3
4
5Column1Column2Custom.2.Column1Custom.2.Column2.2
6Vendor 1this is a testBlue Box-Marketing234000
7Vendor 1this is a testMustard-Marketing345000
8Vendor 1this is a testClassic Red-Marketing135000
Sheet1
 

Watch MrExcel Video

Forum statistics

Threads
1,122,356
Messages
5,595,681
Members
414,009
Latest member
SNesbyCarr

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top