Transpose Multiple Rows into 2 Columns

[dabigmonky]

Hello, can anyone tell me how to transpose these rows while keep 1 value consistent.

For example, transpose the following data:


[TABLE="width: 500"]
<tbody>[TR]
[TD]Kit[/TD]
[TD]Component 1[/TD]
[TD]Component 2[/TD]
[TD]Component 3[/TD]
[TD]Component 4[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]S001[/TD]
[TD]S002[/TD]
[TD]S003[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD]S006[/TD]
[TD]S007[/TD]
[TD]S008[/TD]
[TD]S009[/TD]
[/TR]
</tbody>[/TABLE]

Into this new format:

[TABLE="width: 500"]
<tbody>[TR]
[TD]Kit[/TD]
[TD]Component[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]S001[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]S002[/TD]
[/TR]
[TR]
[TD]ABC[/TD]
[TD]S003[/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD]S006[/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD]S007[/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD]S008[/TD]
[/TR]
[TR]
[TD]DEF[/TD]
[TD]S009[/TD]
[/TR]
</tbody>[/TABLE]

Thanks for the any help that you can give!

 

[WarPigl3t]

Sub myMacro()
    i = 2
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Do Until i > lastRow
        lastCol = Cells(i, Columns.Count).End(xlToLeft).Column
        c = 2
        a = 0
        Do Until c > lastCol
            ReDim myArray(a) as String
            myArray(a) = Cells(i, c).Value
            Cells(i, c).ClearContents
            a = a + 1
            c = c + 1
        Loop
        valueA = Range("A" & i).Value
        For Each arrayValue in myArray
            Range("A" & i).Value = valueA
            Range("B" & i).Value = arrayValue
            i = i + 1
            Rows(i).Insert
        Next arrayValue
        Rows(i).Delete
        i = i + 1
    Loop
End Sub

 

[dabigmonky]

Thanks for the reply WarPiglet.

 

[WarPigl3t]

Made a few mistakes on my last untested code. This one is tested.

Sub myMacro()
    i = 2
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Do Until i > lastRow
        lastCol = Cells(i, Columns.Count).End(xlToLeft).Column
        c = 2
        a = 0
        ReDim myArray(a) As String
        Do Until c > lastCol
            ReDim Preserve myArray(a) As String
            myArray(a) = Cells(i, c).Value
            Cells(i, c).ClearContents
            a = a + 1
            c = c + 1
        Loop
        valueA = Range("A" & i).Value
        For Each Item In myArray
            Range("A" & i).Value = valueA
            Range("B" & i).Value = Item
            i = i + 1
            Rows(i).Insert
        Next Item
        Rows(i).Delete
        lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Loop
End Sub

 

[dabigmonky]

It WORKS! Thanks WarPiglet!

 

[WarPigl3t]

No Problem

 

[WarPigl3t]

You can even add this line of code right after the Sub myMacro()

Application.ScreenUpdating = False

It seems to not output the results until after the macro has fully run. That way you don't see it working when you run the macro. You just see the finished results.

 

[apo]

Here's another.. all calculations done in memory.. and then written to sheet at end..

Result shown in Columns H and I..

Private Sub CommandButton1_Click()
    Dim x, y, i As Long, ii As Long, cnt As Long
    With Range("A1").CurrentRegion
        x = .Offset(1).Resize(.Rows.Count - 1).Value
        ReDim y(1 To Application.CountIf(.Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1), "<>"), 1 To 2)
        cnt = 1
        For i = LBound(x) To UBound(x)
            For ii = 2 To UBound(x, 2)
                If x(i, ii) <> vbNullString Then
                    y(cnt, 1) = x(i, 1)
                    y(cnt, 2) = x(i, ii)
                    cnt = cnt + 1
                End If
            Next ii
        Next i
        .Offset(1, 7).Resize(UBound(y), 2).Value = y
    End With
End Sub

<b>Sheet1</b><br /><br /><table border="1" cellspacing="0" cellpadding="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; padding-left:2pt; padding-right:2pt; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:111px;" /><col style="width:111px;" /><col style="width:111px;" /><col style="width:111px;" /><col style="width:111px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:64px;" /><col style="width:127px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td><td >G</td><td >H</td><td >I</td></tr><tr style="height:31px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Kit</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Component 1</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Component 2</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Component 3</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Component 4</td><td > </td><td > </td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Kit</td><td style="color:#333333; font-weight:bold; font-family:Verdana; font-size:10pt; ">Component</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">ABC</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S001</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S002</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S003</td><td style="color:#333333; font-family:Verdana; font-size:10pt; "> </td><td > </td><td > </td><td >ABC</td><td >S001</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">DEF</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S006</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S007</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S008</td><td style="color:#333333; font-family:Verdana; font-size:10pt; ">S009</td><td > </td><td > </td><td >ABC</td><td >S002</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >ABC</td><td >S003</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >DEF</td><td >S006</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >DEF</td><td >S007</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >DEF</td><td >S008</td></tr><tr style="height:18px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >8</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td><td >DEF</td><td >S009</td></tr></table> <br />Excel tables to the web - Excel Jeanie Html 4