Transpose single row into columns based on value

[EbonyG]

Hello all,
I'm having trouble with data. I have a large output that I initially used a Macro to transpose every n rows to a column. Long story short, that didn't work for the output. So I'm trying to find a way to transpose a single row into columns based on the a common value. This is an example of what I have:

What I would like to do is transpose to a new row every time the text contains "Number:" for something like this:

Any help would be greatly appeciated

 

[DanteAmor]

Try this
Assuming the data starts in A1

Sub TransposeData()
  Dim a As Variant, b As Variant, i As Long, j As Long, k As Long
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 100)
  For i = 1 To UBound(a)
    If UCase(Left(a(i, 1), 6)) = UCase("Number") Then
      k = 1
      j = j + 1
    End If
    b(j, k) = a(i, 1)
    k = k + 1
  Next
  Range("C1").Resize(j, 100).Value = b
End Sub

 

[EbonyG]

Worked like a charm. Never thought to use IF/THEN

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[EbonyG]

When I tried this after transferring data from my notepad, I got subscript error 9 out of range with b(j, k) = a(i, 1) on the debug

 

[DanteAmor]

I got subscript error 9 out of range with b(j, k) = a(i, 1) on the debug

That is because cell A1 does not start with "Number".
Try now:

Sub TransposeData()
  Dim a As Variant, b As Variant, i As Long, j As Long, k As Long
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  ReDim b(1 To UBound(a), 1 To 100)
  For i = 1 To UBound(a)
    If UCase(Left(a(i, 1), 6)) = UCase("Number") Then
      k = 1
      j = j + 1
    End If
    If k > 0 Then
      b(j, k) = a(i, 1)
      k = k + 1
    End If
  Next
  Range("C1").Resize(j, 100).Value = b
End Sub

 

[Fluff]

Another option if there is no space in the "Number:" line

Sub EbonyG()
   Dim Ar As Areas
   Dim Rng As Range
   With Range("A1", Range("A" & Rows.Count).End(xlUp))
      .Replace "number:", "=xxxnumber", xlPart, , False, , False, False
      Set Ar = .SpecialCells(xlConstants).Areas
      .Replace "=xxxnumber", "Number:", xlPart, , False, , False, False
   End With
   For Each Rng In Ar
      Range("C" & Rows.Count).End(xlUp).Offset(1).Resize(, Rng.Count + 1).Value = Application.Transpose(Rng.Offset(-1).Resize(Rng.Count + 1))
   Next Rng
End Sub

 

[EbonyG]

Got it. I had to use text to columns to justify the “number” rows left. Worked using the original script

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.