Convert row with columns of data into column with multiple rows in Excel

Question

I hv rows of data:-

TAG   SKU   SIZE   GRADE   LOCATION
A001  123    12      A       X1
A002  789    13      B       X3
A003  456    15      C       X5
         


        

Answer 1

You can use ADO with Excel. Roughly:

Sub ColsToRows()
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

    ''This is not the best way to refer to the workbook
    ''you want, but it is very convenient for notes
    ''It is probably best to use the name of the workbook.

    strFile = ActiveWorkbook.FullName

    ''Note that if HDR=No, F1,F2 etc are used for column names,
    ''if HDR=Yes, the names in the first row of the range
    ''can be used.
    ''This is the Jet 4 connection string, you can get more
    ''here : http://www.connectionstrings.com/excel

     strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\Docs\TestBook.xls " _
            & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

    ''Late binding, so no reference is needed

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")


    cn.Open strCon

    strSQL = "SELECT [TAG], [SKU], 'SIZE ' & [SIZE] As S, " _
           & "'GRADE ' & [GRADE] As G, 'LOCATION ' & [LOCATION] As L " _
           & "FROM [Sheet1$] a " _
           & "ORDER BY [Tag] "

    rs.Open strSQL, cn, 3, 3


    ''Pick a suitable empty worksheet for the results

    With Worksheets("Sheet3")

        j = 1 '' Row counter

        Do While Not rs.EOF
            For i = 2 To 4
                .Cells(j, 1) = rs!Tag
                .Cells(j, 2) = rs!SKU
                .Cells(j, 3) = rs(i)
                j = j + 1
            Next
            rs.MoveNext
        Loop
    End With

   ''Tidy up
   rs.Close
   Set rs = Nothing
   cn.Close
   Set cn = Nothing

End Sub