Columns and rows display change

[Guest]

Hi,

I have the following set up. The survey data is downloaded form an Access
database into a csv file. I save it as an *.xls file.

The questions are the column headings; the rows are the blocks in which the
survey was taken. (example below). There can only be a maximum of 16
responses per block.

block q1 q2 q3
'19-2007 4 4 5
'19-2007 3 3 3
'19-2007 2 2 3
'19-2007 5 4 5
'19-2007 4 2 4
'19-2007 4 4 4

I want to program the worksheet to transfer the data from this format to
another sheet in the format below:

Responses:
q1 4 3 2 5 4 4

q2 4 3 2 4 2 4

q3 5 5 5 5 5 5

Does anyone know the VBA I would use to perform such a function?

 

[Jim Rech]

Assuming your data:

block q1 q2 q3
'19-2007 4 4 5
'19-2007 3 3 3
'19-2007 2 2 3
'19-2007 5 4 5
'19-2007 4 2 4
'19-2007 4 4 4

is parsed in the range A1 to D7(for example), isn't it just a matter of
copying B17 and then doing a PasteSpecial, Transpose?

--
Jim
| Hi,
|
| I have the following set up. The survey data is downloaded form an Access
| database into a csv file. I save it as an *.xls file.
|
| The questions are the column headings; the rows are the blocks in which
the
| survey was taken. (example below). There can only be a maximum of 16
| responses per block.
|
| block q1 q2 q3
| '19-2007 4 4 5
| '19-2007 3 3 3
| '19-2007 2 2 3
| '19-2007 5 4 5
| '19-2007 4 2 4
| '19-2007 4 4 4
|
| I want to program the worksheet to transfer the data from this format to
| another sheet in the format below:
|
| Responses:
| q1 4 3 2 5 4 4
|
| q2 4 3 2 4 2 4
|
| q3 5 5 5 5 5 5
|
| Does anyone know the VBA I would use to perform such a function?

 

[Guest]

Thank you. That would work. But I need to automate it. This is a small
sample.
I have a download of about 5000 records.

 

[Dave Peterson]

Maybe this will do it:

Option Explicit
Sub testme()
Dim CurWks As Worksheet
Dim NewWks As Worksheet
Dim TopCell As Range
Dim BotCell As Range
Dim HowManyRows As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim iRow As Long
Dim DestCell As Range
Dim ColHeaders As Range

Set CurWks = Worksheets("sheet1")
Set NewWks = Worksheets.Add
Set DestCell = NewWks.Range("a1")

With CurWks
'avoid the grouping column
Set ColHeaders = .Range(.Cells(FirstRow + 1, 2), _
.Cells(1, .Columns.Count).End(xlToLeft))

FirstRow = 2 'headers in row 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

Set TopCell = .Cells(FirstRow, "A")
Set BotCell = TopCell

For iRow = FirstRow + 1 To LastRow + 1
If .Cells(iRow, "A").Value = TopCell.Value Then
'still in same group
Set BotCell = .Cells(iRow, "A")
Else
'new group, do the copy
HowManyRows = BotCell.Row - TopCell.Row + 1

DestCell.Resize(ColHeaders.Columns.Count, 1).Value _
= TopCell.Value

DestCell.Resize(ColHeaders.Columns.Count, 1) _
.Offset(0, 1).Value _
= Application.Transpose(ColHeaders)

TopCell.Offset(0, 1) _
.Resize(HowManyRows, ColHeaders.Columns.Count).Copy
DestCell.Offset(0, 2).PasteSpecial Transpose:=True

'get ready for next group
Set TopCell = .Cells(iRow, "A")
Set BotCell = TopCell
Set DestCell = DestCell.Offset(ColHeaders.Columns.Count, 0)
End If
Next iRow
End With
Application.CutCopyMode = False
End Sub

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm