-
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]
-
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'
-
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
-
Forum Rules