asked on

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?

rjef

ASKER

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

ASKER

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

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

Open in new window

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

ASKER CERTIFIED SOLUTION

Subodh Tiwari (Neeraj)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

rjef

ASKER

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

Saurabh Singh Teotia

rjef,

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

Saurabh...

rjef

ASKER

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

rjef

ASKER

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

Open in new window

rjef

ASKER

sktneer
yours worked perefectly.