Expanding out lists of text with commas

Horse Pop

New Member
Joined
Apr 5, 2013
Messages
4
Hello Mr Excel forum. A friend recommended me this forum.

So, I have a list of data like this:


TypeVarietyCountry of OriginPrice
AppleCox'sUK, South Africa, Spain£1.20
ApplePink LadySouth Africa, Zimbabwe£1.30
AppleGranny SmithUK, France£1.20
OrangeBloodSpain, South Africa£1.30
OrangeTangerineSpain, France£1.40
BananaBendySouth Africa, Zimbabwe£1.20

<tbody>
</tbody>

What I'd like to do is where a Variety has more than one Country of Origin listed, create a new row for each country of origin so the list then looks like:


TypeModelCountry of OriginPrice
AppleCox'sUK£1.20
AppleCox'sSouth Africa£1.20
AppleCox'sSpain£1.20
ApplePink LadySouth Africa, Zimbabwe£1.30
AppleGranny SmithUK, France£1.20
OrangeBloodSpain, South Africa£1.30
OrangeTangerineSpain, France£1.40
BananaBendySouth Africa, Zimbabwe£1.20

<tbody>
</tbody>

Obviously I can do this using text to columns and transpose but typically I'm dealing with much bigger sheets where being able to do this automatically is a big time saving.

The column with commas in it can vary in position so I'd like this to work on the cell/column that is selected.

Ideally I'd like it to work it's way down the sheet expanding out every comma separated list in the selected column in this fashion but even something that worked on the current cell would be handy.

I think roughly I need to split the cell into an array using the comma as a seperator, possibly scrub the spaces from the text, copy the row as many times as there are things in this array (using ubound?) and then transpose the array into an area starting at the selected row and going down as far as there are things in the array but a bit lost with actual implementation.

I am having a look using Google and not finding anyone with exactly the same problem so hope this isn't a duplicate.<style type="text/css">
table.tableizer-table {
border: 1px solid #CCC; font-family: Arial, Helvetica, sans-serif;
font-size: 12px;
}
.tableizer-table td {
padding: 4px;
margin: 3px;
border: 1px solid #ccc;
}
.tableizer-table th {
background-color: #104E8B;
color: #FFF;
font-weight: bold;
}
</style>
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Horse Pop

New Member
Joined
Apr 5, 2013
Messages
4
I am trying to badly adapt some code I found to this purpose -

Code:
 SplitCopyAndTranspose()
Dim N() As String
Dim rowcounter As Integer
Dim rowtocopy As Range
Dim originalcell As Range


Set originalcell = Range(Selection.Address) ' supposed to remember where I started from


Dim I


N = Split(ActiveCell, ",") ' splits the cell into the array
myrow = ActiveWindow.RangeSelection.Row ' Gets the row of the where I started from




For Each I In N ' copies a row for each thing in the array
Rows(myrow).Select
Rows(myrow).EntireRow.Copy
Rows(myrow).Insert shift:=xlDown 
Next




originalcell.Resize(UBound(N) + 1) = WorksheetFunction.Transpose(N) ' Supposed to transpose the array into the column below where I started


End Sub

It is copying the rows down and it is then transposing the data from the array, but it starts doing this from the bottom of the bottom row.

Also it keeps giving me 400 errors in one sheet but not another :S
 

Horse Pop

New Member
Joined
Apr 5, 2013
Messages
4
Bump because I know everyone is on their third cup of tea and raring to help me with this.
 

Horse Pop

New Member
Joined
Apr 5, 2013
Messages
4
Code:
Sub ExpandOutCommas()    Dim a, y, i As Long, J As Long, k As Long, n As Long, x
    Dim divider
    Dim colnumber
    
    divider = InputBox("What character do you want to separate the data by?", "Character to use") ' Reads in whatever character you want to split by
    colnumber = InputBox("Which column number do you want to explode out?", "Column Number") ' Lets you select which column to split up
    
   
   With ActiveSheet.Range("a2").CurrentRegion ' Reads "Currentregion" of A2 into an array
        a = .Value
    End With
    
    ReDim y(1 To Rows.Count, 1 To UBound(a, 2))
    For i = 1 To UBound(a, 1)
        x = Split(a(i, colnumber), divider) ' Splits selected column by divider into an array
        For J = 0 To UBound(x)
            n = n + 1
            For k = 1 To UBound(a, 2) ' Rewrites out each column one at a time
                y(n, k) = a(i, k)
                If k = colnumber Then y(n, k) = x(J) ' Except the column number you chose where it writes out the split values
            Next k
        Next J
    Next i
    With Sheets.Add().Cells(1).Resize(n, UBound(y, 2))
        .Value = y
        .Columns.AutoFit ' Excel stuff to paste it into a new tab
    End With
End Sub

What I ended up with courtesy of AB33. Posting in case anyone else has the same problem.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,721
Messages
5,597,758
Members
414,171
Latest member
12Rev79

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