# How to convert multiple rows into a single row

#### mcva

##### New Member
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 VBA Code:
``````[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

##### New Member
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

### Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.

#### mcva

##### New Member
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

##### Well-known Member
Try the updated below code

VBA 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

End Sub``````

[Code Edited : Added one line]

#### mcva

##### New Member
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

##### New Member
Try the updated below code

VBA 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

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

##### Well-known Member
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

VBA Code:
``````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``````

Replies
1
Views
187
Replies
4
Views
141
Replies
7
Views
452
Replies
6
Views
136
Replies
0
Views
348

### Forum statistics

1,143,677
Messages
5,720,259
Members
422,273
Latest member
linds75 ### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.

### Which adblocker are you using?    1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option. Go back

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com". Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button. Go back