Split text to rown

Question

I am using Excel 2010 and I am having the following data:

As you can see in one row there is multiple data.

My data for product one looks in the cell like that:

Product                                       1.600,00
Other                               1.600,00
EH-Price                                 3.200,00
Pos.-Price                               3.200,00

I would like to split the data the following way:

I tried to transpose the data and then separate it by "space" and then transpose it back, however this does not work well as there are multiple lines.

Have a look here [How to Split a single cell into multiple rows and add another row](https://stackoverflow.com/questions/35439099/how-to-split-a-single-cell-into-multiple-rows-and-add-another-row). The technique you will need is very similar. To split by the linebreaks use `vbLf` as delimiter in the `Split()` function. — Pᴇʜ, Nov 28 '18 at 08:32

Dy.Lee · Answer 1 · 2018-11-28T14:36:31.597

Try this.

Sub Test()
    Dim vDB, vS, vR(), vHead()
    Dim Ws As Worksheet
    Dim n As Long, i As Long, j As Integer
    Dim r As Long, c As Integer, k As Integer
    Dim a As Integer, cnt As Integer

    Set Ws = ActiveSheet
    Ws.Cells.Replace ".", ""
    Ws.Cells.Replace ",", ""

    vDB = Ws.UsedRange
    r = UBound(vDB, 1)
    c = UBound(vDB, 2)

    '@@ get colum's number of data
    For i = 1 To c
        If vDB(2, i) <> "" Then
            k = k + 1
            ReDim Preserve vHead(1 To k)
            vHead(k) = i
        End If
    Next i
    n = 0
    '@@ Cycle the cell to see if chr(10) (vbNewline) is included.
    For i = 1 To r
        If InStr(vDB(i, 1), Chr(10)) Then '~~> if includ  chr(10)
            vS = Split(vDB(i, 1), Chr(10))
            cnt = UBound(vS)
            For a = 0 To cnt
                n = n + 1
                ReDim Preserve vR(1 To c, 1 To n)
                For j = 1 To k
                    vS = Split(vDB(i, vHead(j)), Chr(10))
                    If j = 1 Then
                        vR(vHead(j), n) = Split(vS(a))(0)
                    Else
                        vR(vHead(j), n) = Val(Trim(vS(a)))
                    End If
                Next j
            Next a
        Else '~~> if don't include  chr(10)
            n = n + 1
            ReDim Preserve vR(1 To c, 1 To n)
            vR(1, n) = vDB(i, 1)
        End If
    Next i
    Sheets.Add
    Range("a1").Resize(n, c) = WorksheetFunction.Transpose(vR)
    Range("J:O").NumberFormatLocal = "#,###"

End Sub

Split text to rown

1 Answers1