VBA: Wrapping text and transversing text between nubers or given speific text

I am looking for a VBA solution for
1. transversed text and
2. Wrapping text
between numbers or after and before numbers or given specific text in between. Please find the attachment. My actual row is 1000 rows.

I know its the most easiest but ...

maybe

Sub ertert11()
Dim r As Range, s
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2).Areas
    s = Application.Transpose(r)
    r(1, 3).Resize(, UBound(s)).Value = s
Next r
End Sub

Sub ertert22()
Dim r As Range, s
For Each r In Range("A1", Cells(Rows.Count, 1).End(xlUp)).SpecialCells(2).Areas
    s = Application.Transpose(r)
    r(1, 3).Value = Join(s, Chr(10))
Next r
End Sub

If there is no blank rows in between data, it is transposing all
Can't we transpose data under each numeric number (or given text) I think it can work without blank rows then.

try it

Sub WrappingText()
ertert33 True
End Sub

Sub NotWrappingText()
ertert33 False
End Sub

Sub ertert33(bu As Boolean)
Dim x, i&
x = Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value
With CreateObject("System.Collections.ArrayList")
    For i = UBound(x) To 1 Step -1
        .Add x(i, 1)
        If Val(x(i, 1)) Then
            .Reverse
            If bu Then
                Cells(i, 3) = Join(.toarray, Chr(10))
            Else
                Cells(i, 3).Resize(, .Count) = .toarray
            End If
            .Clear
        End If
    Next i
End With
End Sub

The transverse is not working
1. if I am have only numbers 1, 2, 3, 4, .......
2. If I have text with numbers in between 1, 2, 3, 4, ....... (1 above)

This should do

Sub test()
    Dim x, i As Long
    With Range("a2", Range("a" & Rows.Count).End(xlUp))
        x = Filter(Evaluate("transpose(if(isnumber(left(" & .Address & ",1)+0)," & _
                "row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
        If UBound(x) > -1 Then
            x = Split(Join(x, ",") & "," & .Rows.Count + 1, ",")
            For i = 0 To UBound(x) - 1
                With .Rows(x(i) & ":" & x(i + 1) - 1)
                    .Cells(1).Copy .Cells(1, 3).Resize(, 2)
                    If .Rows.Count > 1 Then
                        .Cells(1, 3).Value = Join(Application.Transpose(.Value), vbLf)
                        .Copy
                        .Cells(1, 4).PasteSpecial Transpose:=True
                    End If
                End With
            Next
        End If
    End With
End Sub

This line is giving problem: .Cells(1, 3).Value = Join(Application.Transpose(.Value), vbLf)

I have got errors where my rows are as
1
1a
bb2
2
2a
3ab
rrr
sss

After transpose the result aswell should be
1 1a bb2
2 2a 3ab rrr sss

Originally Posted by sroysroy

This line is giving problem: .Cells(1, 3).Value = Join(Application.Transpose(.Value), vbLf)

I have got errors where my rows are as
1
1a
bb2
2
2a
3ab
rrr
sss

After transpose the result aswell should be
1 1a bb2
2 2a 3ab rrr sss

I don't believe this at all!

See
Waht are you talking about.xlsm

If you are talking about the file I don't see, forget about the code.

out of Curiosity I thought about changed input.

Can this one help ?



Kind regards
Leo

Or maybe this, works with or without empty rows


Kind regards
Leo