Previous Topic Next Topic

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
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 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 replies

Answer 1 / 4
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
 514
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 Integer

Sheets("Sheet1").Select

lRow = Range("B2").End(xlDown).Row
For 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:=True
Next cell

Sheets("Sheet2").Select
lRow = Range("C" & Rows.Count).End(xlUp).Row
For x = 2 To lRow Step 7
    y = y + 1
    Range("A" & x) = y
Next x

For Each cell In Range("A2:A" & lRow)
    If cell.Value <> vbNullString Then cell.Copy _
    Else: cell.PasteSpecial
Next cell

x = 2
Do
    Range(Cells(x, "B"), Cells(x + 6, "B")).Value = Application.Transpose(Array(1, 2, 3, 4, 5, 6, 7))
    x = x + 7
Loop Until x > lRow

Application.CutCopyMode = False

End Sub

Best regards,
Trowa
0
AAC
Oct 17, 2013 at 07:17 PM
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
0
Answer 2 / 4
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.
0
Answer 3 / 4
AAC
Oct 17, 2013 at 07:20 PM
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
0
Answer 4 / 4
TrowaD
Posts
2886
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
June 27, 2022
 514
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 Integer

Sheets("Sheet1").Select

lRow = Range("B2").End(xlDown).Row
For 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:=True
Next cell

Sheets("Sheet2").Select
lRow = Range("C" & Rows.Count).End(xlUp).Row
For x = 2 To lRow Step 35
    y = y + 1
    Range("A" & x) = y
Next x

For Each cell In Range("A2:A" & lRow)
    If cell.Value <> vbNullString Then cell.Copy _
    Else: cell.PasteSpecial
Next cell

x = 2
Do
    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 + 35
Loop Until x > lRow

Application.CutCopyMode = False

End Sub

Best regards,
Trowa
0