# Macro to traspose data

Solved/Closed
aac1975 Posts 2 Registration date Sunday October 13, 2013 Status Member Last seen October 14, 2013 - Oct 13, 2013 at 11:13 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Oct 21, 2013 at 12:05 PM
Hi I need a help
I need to transpose my data following way for a longitudinal analysis;

ID Day1 Day2 Day3 Day4 Day5 Day6 Day7
1 7 8 9 0 6 9 4
2 8 3 9 6 8 9 7
3 2 8 9 9 6 9 4
4 7 6 9 0 6 9 7
5 8 8 9 6 8 9 4
6 7 8 9 0 6 9 7
7 7 6 9 0 6 3 4
8 8 8 9 7 6 9 4
9 7 7 9 0 6 9 7
10 5 8 9 0 6 9 4

I want to transpose it in flawing shape

ID Day Working hour
1 1 7
1 2 8
1 3 9
1 4 0
1 5 6
1 6 9
1 7 4
2 1 8
2 2 3
2 3 9
2 4 6
2 5 8
2 6 9
2 7 7

And so on

Tx for help. AAC

## 4 responses

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 14, 2013 at 10:53 AM
Hi AAC,

This is what I did:
- Pasted your sample data on Sheet1 which covered the cells A1:H11.
- Added sheet and named it Sheet2.
- Added header to Sheet2 (ID, Day, Working hour) which covered the cells A1:C1.

Then I run the following code:
`Sub RunMe()Dim lRow, x, y As IntegerSheets("Sheet1").SelectlRow = Range("B2").End(xlDown).RowFor Each cell In Range("B2:B" & lRow)    Range(cell, cell.Offset(0, 6)).Copy    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=TrueNext cellSheets("Sheet2").SelectlRow = Range("C" & Rows.Count).End(xlUp).RowFor x = 2 To lRow Step 7    y = y + 1    Range("A" & x) = yNext xFor Each cell In Range("A2:A" & lRow)    If cell.Value <> vbNullString Then cell.Copy _    Else: cell.PasteSpecialNext cellx = 2Do    Range(Cells(x, "B"), Cells(x + 6, "B")).Value = Application.Transpose(Array(1, 2, 3, 4, 5, 6, 7))    x = x + 7Loop Until x > lRowApplication.CutCopyMode = FalseEnd Sub`

Best regards,
Trowa
Hi
Sorry I am still unable to do it.
In my actual dataset, there is 35 days data (In example I sent you it was for 7 days). Then number of IDs are 1669 (In example I sent there were 10 participants). Can you please modify macro for me, considering that there are 35 days instead of 10 and 1669 participants instead of 10.
AAC
aac1975 Posts 2 Registration date Sunday October 13, 2013 Status Member Last seen October 14, 2013
Oct 14, 2013 at 07:34 PM
Thanks a lot.
Hi

Sorry I am still unable to do it.

In my actual dataset, there is 35 days data (In example I sent you it was for 7 days). Then number of IDs are 1669 (In example I sent there were 10 participants). Can you please modify macro for me, considering that there are 35 days instead of 10 and 1669 participants instead of 10.

AAC
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Oct 21, 2013 at 12:05 PM
Hi AAC,

The code doesn't mind you adding more ID's, adding days is the issue.

Here you go:
`Sub RunMe()Dim lRow, x, y As IntegerSheets("Sheet1").SelectlRow = Range("B2").End(xlDown).RowFor Each cell In Range("B2:B" & lRow)    Range(cell, cell.Offset(0, 34)).Copy    Sheets("Sheet2").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=TrueNext cellSheets("Sheet2").SelectlRow = Range("C" & Rows.Count).End(xlUp).RowFor x = 2 To lRow Step 35    y = y + 1    Range("A" & x) = yNext xFor Each cell In Range("A2:A" & lRow)    If cell.Value <> vbNullString Then cell.Copy _    Else: cell.PasteSpecialNext cellx = 2Do    Range(Cells(x, "B"), Cells(x + 34, "B")).Value = _    Application.Transpose(Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35))    x = x + 35Loop Until x > lRowApplication.CutCopyMode = FalseEnd Sub`

Best regards,
Trowa