Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose Data Macro - Question #2
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 and titer. How do I do that by adding to this macro? Basically, there are 5 variables instead of 3 originally. ------------------------------ 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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Transpose Data Macro - Question #2
I made the code clear and didn't put the data into an array. I made the code a little more clear so it is easy to understand. Sub TransposeIt() Dim arr As Variant Dim r As Long Dim Counter As Long Dim ID As String Dim DestRow As Long DestRow = 1 MaxResults = 0 Set OldSht = ActiveSheet Set DestSht = Worksheets.Add With OldSht Lastrow = .Range("A" & Rows.Count).End(xlUp).Row 'sort twice since you can only sort 3 parameters at a time Rows("1:" & Lastrow).Sort _ header:=xlNo, _ Key1:=.Range("D1"), _ order1:=xlAscending, _ Key2:=.Range("E1"), _ order2:=xlAscending, _ Key3:=.Range("F1"), _ order3:=xlAscending Rows("1:" & Lastrow).Sort _ header:=xlNo, _ Key1:=.Range("A1"), _ order1:=xlAscending, _ Key2:=.Range("B1"), _ order2:=xlAscending, _ Key3:=.Range("C1"), _ order3:=xlAscending ID = "" For RowCount = 1 To Lastrow NewID = .Range("A" & RowCount) If ID < NewID Then ColCount = 2 DestRow = DestRow + 1 ID = NewID DestSht.Range("A" & DestRow) = ID ResultsCount = 0 End If 'put header row for new data ResultsCount = ResultsCount + 1 If ResultsCount MaxResults Then With DestSht MaxResults = ResultsCount Cells(1, ColCount) = "Date " & ResultsCount Cells(1, ColCount + 1) = "Test " & ResultsCount Cells(1, ColCount + 2) = "Result " & ResultsCount Cells(1, ColCount + 3) = "TiterA " & ResultsCount Cells(1, ColCount + 4) = "TiterB " & ResultsCount End With End If DestSht.Cells(DestRow, ColCount) = .Range("B" & RowCount) DestSht.Cells(DestRow, ColCount + 1) = .Range("C" & RowCount) DestSht.Cells(DestRow, ColCount + 2) = .Range("D" & RowCount) DestSht.Cells(DestRow, ColCount + 3) = .Range("E" & RowCount) DestSht.Cells(DestRow, ColCount + 4) = .Range("F" & RowCount) ColCount = ColCount + 5 Next RowCount MsgBox "Done" End With End Sub -- joel ------------------------------------------------------------------------ joel's Profile: http://www.thecodecage.com/forumz/member.php?userid=229 View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=151863 Microsoft Office Help |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Transpose data macro | Excel Programming | |||
How do I group and transpose data - macro help needed. | Excel Worksheet Functions | |||
Transpose Question | Excel Programming | |||
Macro to transpose data to fill blank cells in table | Excel Programming | |||
Help with macro to transpose data | Excel Programming |