Moving data from columns into rows

[Jonathan Jones]

Hi,

I have a sheet with several rows of product codes. In several columns I have components for each product row and the number of components used per product. I would like to get the data from the columns into a single column with several rows. It's probably better if I explain as follows:

Current data:

Product Codes ComponentCode1 Component1Qty ComponentCode2 Component2Qty ComponentCode3 Component3Qty

TABLE1 TABLELEG 4 TABELTOP 1 SCREW 3
TABLE2 TABLELEG 2 TABLETOP 1 SCREW2 4

How I want the data to look:

Product Code Component ComponentQty

TABLE1 TABLELEG 4
TABLE1 TABLETOP 1
TABLE1 SCREW 3
TABLE2 TABLELEG 2
TABLE2 TABLETOP 1
TABLE2 SCREW2 4

Any help would be much appreciated,

Jonathan

 

[alansidman]

Option Explicit


Sub ATranspose()
    Dim s1 As Worksheet, s2 As Worksheet
    Dim i As Long, lr As Long, lr2 As Long, j As Long, lc As Long
    Dim myarr As Variant
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    lc = s1.Cells(1, Columns.Count).End(xlToLeft).Column
    myarr = Array("Product Codes", "Component Code", "Component Qty")
    Application.ScreenUpdating = False
    s2.Range("A1:C1") = myarr
    For i = 2 To lr
        For j = 2 To lc - 1
            lr2 = s2.Range("B" & Rows.Count).End(xlUp).Row
            s1.Range("A" & i).Copy s2.Range("A" & lr2 + 1)
            Application.Union(s1.Cells(i, j), s1.Cells(i, j + 1)).Copy
            s2.Range("B" & lr2 + 1).PasteSpecial xlPasteValues
            j = j + 1
        Next j
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

 

[Jonathan Jones]

Hi,

I'm struggling to get this to work, I'm probably just being stupid.

I have one sheet, titled "Sheet1", and my column headings are:
[TABLE="width: 559"]
<tbody>[TR]
[TD="width: 243"]A= Product Code
B= COMPONENT_CODE_1
C= COMPONENT_QTY_1
D= COMPONENT_CODE_2... etc., to COMPONENT_QTY_50

As most items don't have 50 components or anywhere near 50 components, it would be good to removed the blanks too.

Any help would be much appreciated.[/TD]
[TD="width: 252"][/TD]
[TD="width: 64"][/TD]
[/TR]
</tbody>[/TABLE]

 

[alansidman]

where are the blanks located? Is it possible to have data in column D,E,F, M, LN so that there are blanks between F and M