OzGrid

 Category: [Excel]  Demo Available 

---

How to use VBA to turn columns into rows

 

Requirement:

 

The user has a very large spreadsheet which contains around 2000 rows, the first six columns of which are master data.

 

Thereafter, there is a number of six-column blocks that contain "sets" of transactional data. All rows have at least one six-column block, some have more, up to a maximum of 87 blocks (meaning 6*87 columns). Beyond the point at which any given row "runs out" of data, it's completely empty.

The user needs to do is this: for any row which has more than one set of transactional data (i.e. any row with data in column M or beyond), the user needs to cut the data out, in six-column blocks, and paste that into new rows beneath the first set of transactional data.

So, the user is going from this:

... to this:

As you can see, the master data doesn't need to be copied down into the new rows, and once the transactional data "runs out" for any given line, I can stop inserting rows and cutting the data into them (so there won't be any empty rows in the final data).

 

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1214822-vba-turn-columns-into-rows

 

Solution:

 

Sub RearrangeData()
    Dim x, y(), z, i As Long, ii As Long, iii As Long, iv As Long, v As Long
    
    With ActiveSheet.Cells(1).CurrentRegion
        x = .Value2
        For i = 1 To UBound(x, 1)
            iii = iii + 1: ReDim Preserve y(1 To 12, 1 To iii)
            For ii = 1 To 12
                y(ii, iii) = x(i, ii)
            Next
            iv = 13
            Do Until x(i, iv) = vbNullString
                v = 6
                iii = iii + 1: ReDim Preserve y(1 To 12, 1 To iii)
                For ii = iv To iv + 5
                    v = v + 1
                    y(v, iii) = x(i, ii)
                Next
                iv = iv + 6
                If iv >= UBound(x, 2) Then Exit Do
            Loop
        Next
        If iii > .Parent.Rows.Count Then
            MsgBox "There are insufficient rows on the worksheet to rearrange the data.", 16, "Data too large"
            Exit Sub
        End If
        ReDim z(1 To iii, 1 To 12)
        For i = 1 To iii
            For ii = 1 To 12
                z(i, ii) = y(ii, i)
            Next
        Next
        .Clear
        .Parent.[a1].Resize(iii, 12) = z
    End With
    
End Sub

 

Obtained from the OzGrid Help Forum.

Solution provided by KjBox.

 

See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets

 

See also:

How to use the CONCATENATE function to link text in two columns

How to combine multiple rows and columns into one row and one column

How to convert split formula in VBA in their respective columns

How to move monthly data into columns to rows

How to use code to remove columns

 

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.

 

 

 

Gallery

---

• 
• 
• 
• 
• 
•