Previous Topic Next Topic

Macro to traspose data

[Solved/Closed]
Report
Posts
2
Registration date
Sunday October 13, 2013
Status
Member
Last seen
October 14, 2013
 -
Posts
2809
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 23, 2021
 -
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
Posts
2809
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 23, 2021
 484
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
Report

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
Answer 2 / 4
Posts
2
Registration date
Sunday October 13, 2013
Status
Member
Last seen
October 14, 2013
Thanks a lot.
Answer 3 / 4

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
Answer 4 / 4
Posts
2809
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
September 23, 2021
 484
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
Ask a question