Data extraction & population

[deduwa]

Is it possible to automate the following;


I have 2 sheets. Sheet2 is raw data with 8 columns and dynamic number of rows. Sheet1 is blank and will extract data from Sheet2.


In Sheet2;
- column A is populated with unique student ID
- column E is populated with their exam grade
- column G has the persons class
- column H has the persons year
- there is only 1 row per student


In Sheet1 and starting from row 2, I need to effectively create 3 rows for each student (One to show the students exam grade, one for class and one for year. The output of Sheet1 should look like the following.


For student 1;
- cell C2:C4 to show their student ID
- cell E2 to have the text "exam grade", cell F2 to have their corresponding exam grade from Sheet2
- cell E3 to have the text "class", cell F3 to have their corresponding class from Sheet2
- cell E4 to have the text "year", cell F4 to have their corresponding year from Sheet2


For student 2;
- cell C5:C7 to show their student ID
- cell E5 to have the text "exam grade", cell F5 to have their corresponding exam grade from Sheet2
- cell E6 to have the text "class", cell F6 to have their corresponding class from Sheet2
- cell E7 to have the text "year", cell F7 to have their corresponding year from Sheet2




And so on, until all students from Sheet2 have been captured in Sheet1.


Is this possible?


Thanks

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG31Jul26
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
ReDim ray(1 To Rng.Count * 3, 1 To 4)
c = 1
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
   ray(c, 1) = Dn.Value
   ray(c, 3) = "Exam Grade"
   ray(c, 4) = Dn.Offset(, 4).Value
   ray(c + 1, 1) = Dn.Value
   ray(c + 1, 3) = "Class"
   ray(c + 1, 4) = Dn.Offset(, 6).Value
   ray(c + 2, 1) = Dn.Value
   ray(c + 2, 3) = "Year"
   ray(c + 2, 4) = Dn.Offset(, 7).Value
    c = c + 3
[COLOR="Navy"]Next[/COLOR] Dn
Sheets("Sheet1").Range("C2").Resize(c, 4).Value = ray

Regards Mick

 

[deduwa]

Thanks Mick that works. One thing - an extra row (not needed) gets created at the very bottom of Sheet1 with #N/A populated in columns C:F

Is there a way to get rid of this?

Thanks

 

[MickG]

Try changing the "C" below to "C-1" as shown:-

Sheets("Sheet1").Range("C2").Resize([COLOR="#FF0000"][SIZE=4][B]c-1[/B][/SIZE][/COLOR], 4).Value = ray

 

[deduwa]

Thanks perfect

 

[MickG]

You're welcome