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:
Who is Participating?

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

x
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:
see attachment
example.pptx
Saurabh Singh TeotiaCommented:
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:
i have attached an example
Report-many-lines.xlsx
Learn SQL Server Core 2016

This course will introduce you to SQL Server Core 2016, as well as teach you about SSMS, data tools, installation, server configuration, using Management Studio, and writing and executing queries.

Saurabh Singh TeotiaCommented:
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
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
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:
sktneer
there appears to be another character in front of the serial number on some of the results.
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay see the attached now.
Report-many-lines.xlsm
Saurabh Singh TeotiaCommented:
rjef,

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

Saurabh...
rjefAuthor Commented:
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
Saurabh Singh TeotiaCommented:
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:
Saurabh Singh Teotia
here are your results .  see the lengths
results-Saurabh-Singh-Teotia.xlsx
Saurabh Singh TeotiaCommented:
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

Open in new window

rjefAuthor Commented:
sktneer
yours worked perefectly.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.