Microsoft Excel
Microsoft Excel

Excel many items in one field

i have a spread sheet with many items in one cell

column a column b
row1 part1 serial1
serial 2
serial 3
serial 4
row2 part2 serial 5
serial 6
how can i break it down into separate rows for each serial with the part1 in each row?

rjefAsked: 2015-09-02

Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

Experts Exchange Solution brought to you by

Enjoy your complimentary solution view.

Get every solution instantly with Premium. Start your 7-day free trial.

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

rjefAuthor Commented: 2015-09-02

see attachment
example.pptx

LVL 59

Saurabh Singh TeotiaCommented: 2015-09-02

I believe this is what you are looking for..Check Column-C for the formula..its different in C1 and then rest of the cells..

Saurabh...
Parts.xlsx

rjefAuthor Commented: 2015-09-02

i have attached an example
Report-many-lines.xlsx

LVL 59

Saurabh Singh TeotiaCommented: 2015-09-02

Their you this is what you are looking for.. Code for your reference..and check sheet-2 column D&E

Sub breakmydata()
    Dim lrow As Long
    Dim cell As Range, rng As Range
    Dim i As Long, str As String
    Dim k As Long

    lrow = Cells(Cells.Rows.Count, "a").End(xlUp).Row

    Set rng = Range("A2:A" & lrow)
    k = 2
    For Each cell In rng


        For i = 1 To Len(cell.Offset(0, 1).Value)
            Cells(k, "D").Value = cell.Value

            If Asc(Mid(cell.Offset(0, 1).Value, i, 1)) = 13 Or i = Len(cell.Offset(0, 1).Value) Then
                Cells(k, "e").NumberFormat = "@"
                If i = Len(cell.Offset(0, 1).Value) Then
              Cells(k, "e").Value = str & Mid(cell.Offset(0, 1).Value, i, 1)
                Else
                   Cells(k, "e").Value = str
                End If
                
                k = k + 1
                str = ""
            Else
                If str = "" Then
                    str = Mid(cell.Offset(0, 1).Value, i, 1)
                Else
                    str = str & Mid(cell.Offset(0, 1).Value, i, 1)
                End If

            End If

        Next i
    Next cell
End Sub

Open in new window

Saurabh....
Report-many-lines.xlsm

LVL 42

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented: 2015-09-02

Or you may try this also....
To test the code, click the button "Click Here" to get the desired output.

Sub ReArrangeData()
Dim lr As Long, i As Long, r As Long
Dim rng As Range, cell As Range
Dim str() As String

Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set rng = Range("A2:A" & lr)
r = 2
For Each cell In rng
    If InStr(cell.Offset(0, 1), Chr(10)) > 0 Then
        str = Split(cell.Offset(0, 1), Chr(10))
        For i = 0 To UBound(str)
            Range("D" & r).Value = cell
            Range("E" & r).NumberFormat = "@"
            Range("E" & r).Value = str(i)
            r = r + 1
        Next i
    Else
        Range("D" & r).Value = cell
        Range("E" & r).Value = cell.Offset(0, 1)
    End If
Next cell
    
Application.ScreenUpdating = True
MsgBox "Finished.", vbInformation
End Sub

Open in new window

Report-many-lines.xlsm

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial

rjefAuthor Commented: 2015-09-03

sktneer
there appears to be another character in front of the serial number on some of the results.

LVL 42

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented: 2015-09-03

Okay see the attached now.
Report-many-lines.xlsm

LVL 59

Saurabh Singh TeotiaCommented: 2015-09-03

rjef,

Did you run my code?? What is your finding on the same??

Saurabh...

rjefAuthor Commented: 2015-09-03

Saurabh Singh Teotia
Actually your code was the one with the extra character on some of the results.

sktneer
i will check your code in the morning

LVL 59

Saurabh Singh TeotiaCommented: 2015-09-04

rjef,

When you mean extra characters? Can you help me understand what you mean by that I can resolve that quickly if i understand what you are referring to?

Saurabh..

rjefAuthor Commented: 2015-09-04

Saurabh Singh Teotia
here are your results . see the lengths
results-Saurabh-Singh-Teotia.xlsx

LVL 59

Saurabh Singh TeotiaCommented: 2015-09-04

Rjef,

Use this code...

Sub breakmydata()
    Dim lrow As Long
    Dim cell As Range, rng As Range
    Dim i As Long, str As String
    Dim k As Long

    lrow = Cells(Cells.Rows.Count, "a").End(xlUp).Row

    Set rng = Range("A2:A" & lrow)
    k = 2
    For Each cell In rng


        For i = 1 To Len(cell.Offset(0, 1).Value)
            Cells(k, "D").Value = cell.Value

            If Asc(Mid(cell.Offset(0, 1).Value, i, 1)) = 13 Or i = Len(cell.Offset(0, 1).Value) Then
                Cells(k, "e").NumberFormat = "@"
                If i = Len(cell.Offset(0, 1).Value) Then
              Cells(k, "e").Value = str & Mid(cell.Offset(0, 1).Value, i, 1)
                Else
                   Cells(k, "e").Value = Trim(Replace(str, Chr(10), ""))
                End If
                
                k = k + 1
                str = ""
            Else
                If str = "" Then
                    str = Mid(cell.Offset(0, 1).Value, i, 1)
                Else
                    str = str & Mid(cell.Offset(0, 1).Value, i, 1)
                End If

            End If

        Next i
    Next cell
End Sub