transposing and creating new rows

[krove]

I am dealing with a set of Excel 2002 worksheets organized in a standard
format in which each row represents a record for a single day and there are
numerous variables recorded in columns. I need to transpose this to a format
in which there is a single row for each non-zero occurence of each variable
on each day, and the row needs to keep the date as its first-column entry.

To illustrate, I need to change this:
date1 v1 v2 v3 v4
date2 v1 v2 v3 v4...

to this:
date1 v1
date1 v2
date1 v3
date1 v4
date2 v1
date2 v2...

This seems like a perfect task for a macro, but my macro literacy is
insufficient to figure it out. Any suggestions geared toward a non-VBASIC
-speaker would be greatly appreciated. Thanks in advance for any tips you
can send my way.

 

[Tom Ogilvy]

Sub TransposeData()
Dim rng as Range, rng1 as Range, rng2 as Range
Dim rng3 as Range, cell as Range
With worksheets("Sheet1")
set rng = .range(.cells(1,1),.cells(1,1).End(xldown))
End with
for each cell in rng
set rng1 = cell.Offset(0,1).resize(1,20) ' change 20 to the number of
variables
set rng2 = Worksheets("sheet2").Cells(rows.count,2).End(xlup)(2)
rng1.copy
rng2.PasteSpecial xlValues, Transpose:=True
set rng3 = Worksheets("Sheet2").Cells(rows.count,2).End(xlup)
worksheets("Sheet2").Range(rng2,rng3).Offset(0,-1).Value = _
cell.Value
Next
End Sub

code is untested but should be pretty much what you describe.

 

[Tom Ogilvy]

Open only this workbook

to Alt+F11 to get into the VBE

in the menu Choose
Insert=>Module

paste in the code below



Sub TransposeData()
Dim rng As Range, rng1 As Range, rng2 As Range
Dim rng3 As Range, cell As Range, Labels As Range
With Worksheets("Sheet1")
Set rng = .Range(.Cells(2, 1), .Cells(2, 1).End(xlDown))
Set Labels = .Range(.Cells(1, 2), .Cells(1, 2).End(xlToRight))
End With
For Each cell In rng
Set rng1 = cell.Offset(0, 1).Resize(1, Labels.Count)
Set rng2 = Worksheets("sheet2").Cells(Rows.Count, 2).End(xlUp)(2)
Labels.Copy
rng2.PasteSpecial xlValues, Transpose:=True
rng1.Copy
rng2.Offset(0, 1).PasteSpecial xlValues, Transpose:=True
Set rng3 = Worksheets("Sheet2").Cells(Rows.Count, 2).End(xlUp)
Worksheets("Sheet2").Range(rng2, rng3).Offset(0, -1).Value = _
cell.Value
Next
End Sub

 

[krove]

I finally got a chance to try running the two different code options you
suggested. The second one is very close to what I need, and I just need to
know how to modify it to change two things:
1) There is one variable in the range that is not of interest, and I want to
avoid entries for that variable.
2) I don't need the information from cells that are blank or zero in the
original spreadsheet, so I'd like to modify the code to skip those or delete
them from the destination spreadsheet.

Thanks again for the tips so far.