Expanding out lists of text with commas

[Horse Pop]

Hello Mr Excel forum. A friend recommended me this forum.

So, I have a list of data like this:

Type	Variety	Country of Origin	Price
Apple	Cox's	UK, South Africa, Spain	£1.20
Apple	Pink Lady	South Africa, Zimbabwe	£1.30
Apple	Granny Smith	UK, France	£1.20
Orange	Blood	Spain, South Africa	£1.30
Orange	Tangerine	Spain, France	£1.40
Banana	Bendy	South 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:

Type	Model	Country of Origin	Price
Apple	Cox's	UK	£1.20
Apple	Cox's	South Africa	£1.20
Apple	Cox's	Spain	£1.20
Apple	Pink Lady	South Africa, Zimbabwe	£1.30
Apple	Granny Smith	UK, France	£1.20
Orange	Blood	Spain, South Africa	£1.30
Orange	Tangerine	Spain, France	£1.40
Banana	Bendy	South 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>

 

[Horse Pop]

I am trying to badly adapt some code I found to this purpose -

 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]

Bump because I know everyone is on their third cup of tea and raring to help me with this.

 

[Horse Pop]

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.