(VBA) Excel - How to transpose variable length columns to rows?

Question

I have an Excel sheet with variable rows but 5 columns. The final column has comma separated values of varying length.

I have been trying to write a "For Loop" to Transpose this data into Rows while retaining the Data in existing Columns A:D.

Source Data Sample

| User ID | User name | Group ID | Group name | Effective permissions |      |      |      |      |      |
|---------|-----------|----------|------------|-----------------------|------|------|------|------|------|
| 1       | Adam      | 100      | Active     | ABCD                  | RFGE | ERTY | EDFR |      |      |
| 2       | Bryan     | 100      | Bold       | IFEU                  | WASD | WASF | TGRE | YMUN | TYBN |
| 3       | Charles   | 100      | Charity    | IFLL                  | ERTY | WSDF | XKLS |      |      |
| 4       | David     | 100      | Danger     | IFEU                  | UNBY | RVBT | ZXCV | XCVB | VBNM |

Output Data Example

| User ID | User name | Group ID | Group name | Effective permissions |
|---------|-----------|----------|------------|-----------------------|
| 1       | Adam      | 100      | Active     | ABCD                  |
| 1       | Adam      | 100      | Active     | RFGE                  |
| 1       | Adam      | 100      | Active     | ERTY                  |
| 1       | Adam      | 100      | Active     | EDFR                  |
| 2       | Bryan     | 100      | Bold       | IFEU                  |
| 2       | Bryan     | 100      | Bold       | WASD                  |
| 2       | Bryan     | 100      | Bold       | WASF                  |
| 2       | Bryan     | 100      | Bold       | TGRE                  |
| 2       | Bryan     | 100      | Bold       | YMUN                  |
| 2       | Bryan     | 100      | Bold       | TYBN                  |
| 3       | Charles   | 100      | Charity    | IFLL                  |
| 3       | Charles   | 100      | Charity    | ERTY                  |
| 3       | Charles   | 100      | Charity    | WSDF                  |
| 3       | Charles   | 100      | Charity    | XKLS                  |
| 4       | David     | 100      | Danger     | IFEU                  |
| 4       | David     | 100      | Danger     | UNBY                  |
| 4       | David     | 100      | Danger     | RVBT                  |
| 4       | David     | 100      | Danger     | ZXCV                  |
| 4       | David     | 100      | Danger     | XCVB                  |
| 4       | David     | 100      | Danger     | VBNM                  |

Any help you could provide would be greatly appreciated.

**I have completed VBA projects in the past, however I have usually been able to piece together previous examples to achieve my goal...learning along the way.

If someone could show me how to adapt the below code so that each of the values in my first 4 columns are copied down that would be great.

Sub Test()

Set Rng = Sheets("Test").Range("D2:D15")
Set Rng_output = Sheets("Test2").Range("A2")

For i = 1 To Rng.Cells.Count
    Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))

    If rng_values.Cells.Count < 16000 Then
        For j = 1 To rng_values.Cells.Count
                Rng_output.Value = Rng.Cells(i).Value
                Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value
                Set Rng_output = Rng_output.Offset(1, 0)
        Next j
    End If
Next i

End Sub

^^ And also don't screen shot data as we can't copy paste that for testing. Use a tool like a [markdown table generator](https://www.tablesgenerator.com/markdown_tables) to format the data for insert between code tags. — QHarr, Sep 10 '18 at 09:38
I tried following this related question: https://stackoverflow.com/questions/44655553/vba-excel-with-thousands-of-rows-how-to-transpose-variable-length-columns-to (The Apples/Bananas solutions is very close to what I would like to achieve) However, in my example I have columns A:D to copy down the row data. @QHarr thanks, I tried for a while before resorting to the picture. I'll change it. — Tony Butcher, Sep 11 '18 at 07:04

score 0 · Answer 1 · answered Sep 12 '18 at 19:35

You are very close with that code.

Here is the same code, with a few small changes:

Sub Test()

    Set Rng = Sheets("Test").Range("D2:D15")
    Set Rng_output = Sheets("Test2").Range("A2")

    For i = 1 To Rng.Cells.Count

        'Test to make sure there is less than 16000 columns in this row past D. Yikes, OP!
        Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight))
        If rng_values.Cells.Count < 16000 Then      
            'Loop through all of those columns
            For j = 1 To rng_values.Cells.Count         
                'Write out value from Column A:D to our Rng_Output
                Rng_Output.Value = rng.cells(i).Offset(0,-3).value 'Column A = Column A
                Rng_Output.Offset(0,1).Value = rng.cells(i).Offset(0,-2).value 'Column B = Column B
                Rng_Output.Offset(0,2).value = rng.cells(i).OFfset(0,-1).value 'etc..
                Rng_Output.Offset(0,3).value = rng.cells(i).value

                'Write out value from Column A:D to your `Test2` sheet column E                 
                rng_output.Offset(0,1).Value = rng_values.Cells(j).value

                'Increment to the next row
                Set Rng_output = Rng_output.Offset(1)
            Next j
        End If


    Next i

End Sub

(VBA) Excel - How to transpose variable length columns to rows?

1 Answers1