Angie Li
Angie Li

Reputation: 185

Transpose columns to rows using excel macro

I have a excel sheet looks like this: Each "row" like row1 and row2 has a list of items, config, qty, and "rows" are sharing same "position".

+----------+---------+------------------+-------+---------+------------------+-------+
|          |     row1                           |       row2                         |
+----------+---------+------------------+-------+---------+------------------+-------+
|position  | item    | Configuration    | qty   | item    | Configuration    | qty   |
+----------+---------+------------------+-------+---------+------------------+-------+
| 1        | Spaced  |  | Spaced        | 0.00  | Spaced  |  | Spaced        | 0.00  |
| 2        | NoFiber |  | NoFiber       | 0.00  | NoFiber |  | NoFiber       | 0.00  |
| 3        | NoFiber |  | NoFiber       | 0.00  | NoFiber |  | NoFiber       | 0.00  |
| 4        | Empty   | inla | Empty     | 0.00  | Empty   | inkz | Empty     | 0.00  |
| 5        | Empty   | inla | Empty     | 0.00  | Empty   | inkz | Empty     | 0.00  |
| 6        | Empty   | inkq | Empty     | 0.00  | Empty   | inkp | Empty     | 0.00  |
| 7        | Empty   | inkq | Empty     | 0.00  | Empty   | inkp | Empty     | 0.00  |
| 8        | Empty   | inkf | Empty     | 0.00  | Empty   | inke | Empty     | 0.00  |
| 9        | Empty   | inkf | Empty     | 0.00  | Empty   | inke | Empty     | 0.00  |
| 10       | 98211   | inht inid | Iota | 19.23 | 98210   | inhs inic | Iota | 19.23 |
| 11       | 98209   | ingy inhj | Iota | 19.23 | 98208   | ingx inhi | Iota | 19.23 |
| 12       | Spaced  | ingo | Spaced    | 0.00  | Spaced  | ingn | Spaced    | 0.00  |
| 13       | 99186   | ingo | Ibis      | 54.79 | 99185   | ingn | Ibis      | 54.79 |
+----------+---------+------------------+-------+---------+------------------+-------+

I want to use macro to transpose to look like this.

+----------+---------+------+--------+------------------+
| position |  bbnum  | row  |  qty   |  Configuration   |
+----------+---------+------+--------+------------------+
|        1 | Spaced  | row1 | 0      |  | Spaced        |
|        2 | NoFiber | row1 | 0      |  | NoFiber       |
|        3 | NoFiber | row1 | 0      |  | NoFiber       |
|        4 | Empty   | row1 | 0      | inla | Empty     |
|        5 | Empty   | row1 | 0      | inla | Empty     |
|        6 | Empty   | row1 | 0      | inkq | Empty     |
|        7 | Empty   | row1 | 0      | inkq | Empty     |
|        8 | Empty   | row1 | 0      | inkf | Empty     |
|        9 | Empty   | row1 | 0      | inkf | Empty     |
|       10 | 98211   | row1 | 19.228 | inht inid | Iota |
|       11 | 98209   | row1 | 19.228 | ingy inhj | Iota |
|       12 | Spaced  | row1 | 0      | ingo | Spaced    |
|       13 | 99186   | row1 | 54.791 | ingo | Ibis      |
|        1 | Spaced  | row2 | 0      |  | Spaced        |
|        2 | NoFiber | row2 | 0      |  | NoFiber       |
|        3 | NoFiber | row2 | 0      |  | NoFiber       |
|        4 | Empty   | row2 | 0      | inkz | Empty     |
|        5 | Empty   | row2 | 0      | inkz | Empty     |
|        6 | Empty   | row2 | 0      | inkp | Empty     |
|        7 | Empty   | row2 | 0      | inkp | Empty     |
|        8 | Empty   | row2 | 0      | inke | Empty     |
|        9 | Empty   | row2 | 0      | inke | Empty     |
|       10 | 98210   | row2 | 19.23  | inhs inic | Iota |
|       11 | 98208   | row2 | 19.23  | ingx inhi | Iota |
|       12 | Spaced  | row2 | 0      | ingn | Spaced    |
|       13 | 99185   | row2 | 54.79  | ingn | Ibis      |

+----------+---------+------+--------+------------------+

How can I make it happen using macro since there are ~20 "rows" and ~40 "positions" in my sheet. I'm new to macro so hopefully I can make this automated otherwise I'm copying and pasting all of them manually. Thanks!

Upvotes: 0

Views: 7664

Answers (1)

peege
peege

Reputation: 2477

This will work over as many columns as you have. As long as there are 4 columns in each Row group. Explanation:

Get the last row of the source sheet and the last column. Identify how many columns are in each group. Loop through the column groups one "ROW#" (your label) at a time, through all rows deep.
Copy the data to the target sheet, in the format you want Go to next Column Group

Setup: You will need to create a new Sheet.
example: "Target".

Then set up the header rows.
example: data starts on row 2 of Target Sheet

Make sure to check the code to see where the columns and rows begin on the source sheet.

Set the name of your source sheet in the code.

TESTED:

Sub ColumnCopy()

Dim lastRow As Long
Dim lastCol As Long
Dim colBase As Long

Dim tRow As Long
Dim source As String
Dim target As String
    
    source = "Sheet1"       'Set your source sheet here
    target = "Target"       'Set the Target sheet name
    
    tRow = 2                'Define the start row of the target sheet
    
    'Get Last Row and Column
    lastRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).Row
    lastCol = Sheets(source).Cells(2, Columns.Count).End(xlToLeft).Column
    
    tRow = 2
    colBase = 2
    Do While colBase < lastCol
        For iRow = 3 To lastRow
            Sheets(target).Cells(tRow, 1) = Sheets(source).Cells(iRow, 1)           'Position
            Sheets(target).Cells(tRow, 2) = Sheets(source).Cells(iRow, colBase)      'bbnum
            Sheets(target).Cells(tRow, 3) = Sheets(source).Cells(1, colBase)         'Getting The Row#, from Row 1
            Sheets(target).Cells(tRow, 4) = Sheets(source).Cells(iRow, colBase + 3)  'qty
            Sheets(target).Cells(tRow, 5) = Sheets(source).Cells(iRow, colBase + 1)  'Configuration Col 1
            Sheets(target).Cells(tRow, 6) = Sheets(source).Cells(iRow, colBase + 2)  'Configuration Col 2
            tRow = tRow + 1
        Next iRow
        colBase = colBase + 4       'Add 4 to the Column Base.  This shifts the loop over to the next Row set.
    Loop
End Sub

Source enter image description here

edit:corrected typo in code

Upvotes: 4

Related Questions