Consulting

Results 1 to 3 of 3

Thread: Code to move row data to columns

  1. #1
    VBAX Newbie
    Joined
    Oct 2010
    Posts
    2
    Location

    Code to move row data to columns

    Wondering if I can get some help using code to move data from rows to columns. I've created code that works as long as the header and data are on one row. Where I run into problems is when the data for the header goes into the next row. The .csv file contains the same headers (Date:, Tag:, Comment but in rows. Data for the Comment: header is the only one that spans multiple row. Any help would be greatly appreciated.

    Example:
    Column A, Column B
    Date: (Header), 10/14/10 (Data)
    Name: (Header), Point1 (Data)
    Commnet: (Header), Instrucions1 (Data)
    Instrucions2 (Data), blank
    Instructions3 (Data), blank
    Date: (Header), 10/15/10 (Data)
    Name: (Header), Point2 (Data)
    Commnet: (Header), Instrucions1 (Data)
    Instrucions2 (Data), blank
    Instructions3 (Data), blank

    What I would like it to look like is:
    Column A, Column B, Column C
    Date:, Tag:, Comment:
    10/14/10, Point1, Instruction1 Instruction2 Instruction3
    10/15/10, Point2, Instruction1 Instruction2 Instruction3

    Code I'm currently using:
    [VBA]Sub RowDataToColumn()
    Dim Headings(), Heads As Range

    'Set Column Headers for 1st Query, data starts on Row 1
    Headings = Array("Date:")

    'Set Range to Place Headers
    Sheets("sheet2").Range("A1:A1") = Application.Transpose(Application.Transpose(Headings))

    'Search for Header Data
    For Each Heads In Sheets("sheet2").Range("A1:A1")
    With Sheets("sheet1").Range("A1:B" & [a65536].End(xlUp).Row)
    .AutoFilter Field:=1, Criteria1:=Heads
    .Offset(0, 1).Resize(.Rows.Count, 1).Copy
    Sheets("sheet2").Cells(Rows.Count, Heads.Column).End(xlUp).Offset(1).PasteSpecial xlValues
    .AutoFilter
    End With
    Next

    'Set Column Headers for 2nd Query, data starts on 2nd row
    Headings = Array("Name:", "Comment:")

    'Set Range to Place Headers
    Sheets("sheet2").Range("B1:C1") = Application.Transpose(Application.Transpose(Headings))

    'Search for Header Data
    For Each Heads In Sheets("sheet2").Range("B1:C1")
    With Sheets("sheet1").Range("A1:B" & [a65536].End(xlUp).Row)
    .AutoFilter Field:=1, Criteria1:=Heads
    .Offset(1, 1).Resize(.Rows.Count - 1, 1).Copy
    Sheets("sheet2").Cells(Rows.Count, Heads.Column).End(xlUp).Offset(1).PasteSpecial xlValues
    .AutoFilter
    End With
    Next

    End Sub[/VBA]

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Welcome to VBAX
    You can post a sample workbook using Manage Attachments in the Go Advanced reply section.
    Code can be formatted using the green VBA button.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    VBAX Newbie
    Joined
    Oct 2010
    Posts
    2
    Location
    Thanks - I attached an example workbook containing the code. sheet1 contains an example of the .csv file that would be imported.

    Thanks again.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •