text to columns

[zs52411940]

Hello guys,

I want to solve the following problem:

The original form is like this

Product(column 1) Style(column 2)
A1 long/short/medium
B short/medium
C long/short
D long
E short

I want to change it to:
Product Style
A1 long
A1 short
A1 medium
B short
B medium
C long
C short
D long
E short

I used to use Text to Column to transfer the second column according to "/", then copy it one by one, like
Product Style
A1 long short medium
But, as there are so many data, it is just not realistic to do it like this anymore. Can anybody help me figure out how to write a vba code to solve this problem? (I borrow books from library, but they are about Excel for numerical methods)

Thanks in advance

 

[texasalynn]

Welcome to MrExcel board....

so I'm not sure I understand, but you have the data in the ]second column with the "/" that you would parse by? But you want the parsed data to go below in the next row under it? So by doing so you would push down the other rows?

 

[zs52411940]

Welcome to MrExcel board....

so I'm not sure I understand, but you have the data in the ]second column with the "/" that you would parse by? But you want the parsed data to go below in the next row under it? So by doing so you would push down the other rows?

Yes exactly, my second column has data divided with "/". I want the parsed data to go below in the next row.

 

[zs52411940]

Yes exactly, my second column has data divided with "/". I want the parsed data to go below in the next row

 

[texasalynn]

ok so try this, but be sure to make a copy of your sheet before trying this

Sub separatefields()
Dim array1 As Variant
Dim counter As Integer
For Each Cell In Selection
counter = (Cell.Column + 1)
array1 = Split(Cell.Value, "/")
    For i = 0 To UBound(array1)
        If i > 2 And i < (UBound(array1) - 1) Then
            Cells(Cell.Row, counter).Value = Cells(Cell.Row, counter).Value & "/" & array1(i)
            If i = UBound(array1) - 2 Then
                counter = counter + 1
            End If
        Else
            Cells(Cell.Row, counter).Value = array1(i)
            counter = counter + 1
        End If
    Next
Next
End Sub
Sub ParseStyle()
Dim LR As Long, i As Long
Application.ScreenUpdating = False
LR = ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row
Range("B2:B" & LR).Select
Call separatefields
Range("A1").Select
For i = LR To 2 Step -1
    x = Len(Cells(i, 2)) - Len(Application.WorksheetFunction.Substitute(Cells(i, 2).Value, "/", "")) + 1
    If x > 1 Then
        Range(Cells(i + 1, 2), Cells(i + x - 1, 2)).EntireRow.Insert
    End If
    
    For j = 1 To x
    
    Select Case j
    Case 1
        Cells(i, 1) = Cells(i, 1)
        Cells(i, 2) = Cells(i, 2 + j)
        Cells(i, 2 + j).Clear
    Case 2
        Cells(i + j - 1, 1) = Cells(i, 1)
        Cells(i + j - 1, 2) = Cells(i, 2 + j)
        Cells(i, 2 + j).Clear
    Case 3
        Cells(i + j - 1, 1) = Cells(i, 1)
        Cells(i + j - 1, 2) = Cells(i, 2 + j)
        Cells(i, 2 + j).Clear
    Case 4
        Cells(i + j, 1) = Cells(i, 1)
        Cells(i + j, 2) = Cells(i, 2 + j)
        Cells(i, 2 + j).Clear
    Case Else
    ' no data to parse
    End Select
    
    Next j
    
Next i
MsgBox "Done"
Application.ScreenUpdating = False
End Sub

 

[zs52411940]

It works very well. Thanks very much.

 

[texasalynn]

Your welcome and thanks for the feedback

 

[zs52411940]

Thank you, MrExcel board is terrific.
One more question: How should I change the code if I have more columns with similar situation?

 

[texasalynn]

post a sample of your data, using one of the display programs available

http://www.mrexcel.com/htmlmaker2010/HtmlMaker20090730a.zip
http://www.excel-jeanie-html.de/html/hlp_schnell_en.php

the code I gave you before splits the data on the row, so that will be a problem that would require it to be rewritten