# 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?
Microsoft Excel

Last Comment
rjef

8/22/2022 - Mon
rjef

see attachment
example.pptx
Saurabh Singh Teotia

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
rjef

i have attached an example
Report-many-lines.xlsx
All of life is about relationships, and EE has made a viirtual community a real community. It lifts everyone's boat
William Peck
Saurabh Singh Teotia

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
``````

Saurabh....
Report-many-lines.xlsm
Subodh Tiwari (Neeraj)

Become an EE member today7-DAY FREE TRIAL
Members can start a 7-Day Free trial then enjoy unlimited access to the platform
or
Learn why we charge membership fees
We get it - no one likes a content blocker. Take one extra minute and find out why we block content.
Not exactly the question you had in mind?
Sign up for an EE membership and get your own personalized solution. With an EE membership, you can ask unlimited troubleshooting, research, or opinion questions.
rjef

sktneer
there appears to be another character in front of the serial number on some of the results.
Subodh Tiwari (Neeraj)

Okay see the attached now.
Report-many-lines.xlsm
Get an unlimited membership to EE for less than \$4 a week.
Unlimited question asking, solutions, articles and more.
Saurabh Singh Teotia

rjef,

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

Saurabh...
rjef

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 Teotia

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..
Your help has saved me hundreds of hours of internet surfing.
fblack61
rjef

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

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
``````
rjef