How to convert multiple rows into a single row

[mcva]

Hello, I´m beginning to learn vba, and I just can´t solve this one. If someone can help me...thank you
I have several excel worksheets that approximatly 7336 rows filed with groups of numbers with different column and row length.
The output I need is below. Basically inside each group all rows are aligned.
I have used without success the code below. I just can´t make it go trough all the groups
Thank you

[CODE=vba]Sub convertMultipleRowsToOneRow()
    Set myRange = Application.InputBox("select one range that you want to convert:", "", Type:=8)
    Set dRang = Application.InputBox("Select one Cell to place data:", "", Type:=8)
    rowNum = myRange.Rows.Count
    colNum = myRange.Columns.Count
    For i = 1 To rowNum
        myRange.Rows(i).Copy dRang
        Set dRang = dRang.Offset(0, colNum + 0)
    Next
End Sub

[/CODE]

 

[mcva]

What is the maximum number of columns you data might extend to ? 10 ? 15 ? And what about maximum number of rows per set

Columns = 8
Rows = 150

 

[mcva]

What is the maximum number of columns you data might extend to ? 10 ? 15 ? And what about maximum number of rows per set

Column 8
Rows 150

 

[mse330]

Try the updated below code

Sub PrepareList()

Dim a As Variant, b As Variant, r&, c&
a = ActiveSheet.UsedRange

ReDim b(1 To UBound(a), 1 To UBound(a, 2))
r = 1: c = 1
For x = 1 To UBound(a)
    For y = 1 To UBound(a, 2)
        If a(x, 1) = vbNullString Then
            r = r + 1
            c = 1
            Exit For
        ElseIf a(x, y) = vbNullString Then
            Exit For
        Else
            b(r, c) = a(x, y)
            If c + 1 > UBound(b, 2) Then
                ReDim Preserve b(1 To UBound(a), 1 To c + 1)
                c = c + 1 '<--- added this line
            Else
                c = c + 1
            End If
        End If
    Next y
Next x

Sheets.Add(after:=Sheets(Sheets.Count)).Range("A1").Resize(UBound(b), UBound(b, 2)) = b

End Sub

[Code Edited : Added one line]

 

[mcva]

Thank you works perfectly. I would never have been able to solve this. Now I have an excellent example for studying. Thank you very much!

 

[mcva]

Try the updated below code

Sub PrepareList()

Dim a As Variant, b As Variant, r&, c&
a = ActiveSheet.UsedRange

ReDim b(1 To UBound(a), 1 To UBound(a, 2))
r = 1: c = 1
For x = 1 To UBound(a)
    For y = 1 To UBound(a, 2)
        If a(x, 1) = vbNullString Then
            r = r + 1
            c = 1
            Exit For
        ElseIf a(x, y) = vbNullString Then
            Exit For
        Else
            b(r, c) = a(x, y)
            If c + 1 > UBound(b, 2) Then
                ReDim Preserve b(1 To UBound(a), 1 To c + 1)
                c = c + 1 '<--- added this line
            Else
                c = c + 1
            End If
        End If
    Next y
Next x

Sheets.Add(after:=Sheets(Sheets.Count)).Range("A1").Resize(UBound(b), UBound(b, 2)) = b

End Sub

[Code Edited : Added one line]

Thank you works perfectly. I would never have been able to solve this. Now I have an excellent example for studying. Thank you very much

 

[mse330]

Glad to help & this forum is really a good place to learn from others … I don't have access to your data set but using ReDim Preserve extensively might slow down your code. So if your maximum number of columns is 1200 (8 * 150) then you can change the below line

ReDim b(1 To UBound(a), 1 To UBound(a, 2)) 'Remove this line

ReDim b(1 To UBound(a), 1 To 1200) 'Replace it with this line