View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Lars-Åke Aspelin[_2_] Lars-Åke Aspelin[_2_] is offline
external usenet poster
 
Posts: 913
Default Transpose data macro

On Mon, 2 Nov 2009 13:36:00 -0800 (PST), Pauline Han
wrote:

I have a dataset with multiple records per ID:
ID date test result
1
1
1
2
2
2
3
3


I want to make it into a dataset like this so that there are unique
IDs:

ID date1 test1 result1 date2 test2 result2
1
2
3

etc.

I have this macro that does it for ID, date and test, but I want to
add result. How do I do that by adding to this macro?

------------------------------
Sub TransposeIt()

Dim arr As Variant
Dim r As Long
Dim Counter As Long
Dim ID As String
Dim DestRow As Long

[a1].Sort Key1:=[a1], Order1:=xlAscending, Key2:=[b1],
Order2:=xlAscending, Header:=xlYes
arr = ActiveSheet.UsedRange.Value

Worksheets.Add

[a1] = "ID"
DestRow = 1

For r = 2 To UBound(arr, 1)
If arr(r, 1) < ID Then
DestRow = DestRow + 1
Cells(DestRow, 1) = arr(r, 1)
ID = arr(r, 1)
Counter = 0
End If
Counter = Counter + 1
Cells(1, Counter * 2) = "Date" & Counter
Cells(1, Counter * 2 + 1) = "Test" & Counter
Cells(DestRow, Counter * 2) = arr(r, 2)
Cells(DestRow, Counter * 2 + 1) = arr(r, 3)
Next

MsgBox "Done"

End Sub
------------------------------------------------------

Any help would be much appreciated!!!

Pauline



Try replaceing these four rows

Cells(1, Counter * 2) = "Date" & Counter
Cells(1, Counter * 2 + 1) = "Test" & Counter
Cells(DestRow, Counter * 2) = arr(r, 2)
Cells(DestRow, Counter * 2 + 1) = arr(r, 3)

with these six rows

Cells(1, Counter * 3 - 1) = "Date" & Counter
Cells(1, Counter * 3) = "Test" & Counter
Cells(1, Counter * 3 + 1) = "Result" & Counter
Cells(DestRow, Counter * 3 - 1) = arr(r, 2)
Cells(DestRow, Counter * 3) = arr(r, 3)
Cells(DestRow, Counter * 3 + 1) = arr(r, 4)

Hope this helps / Lars-Åke