Help required to extract data from rows to column in Excel2013

2 Attachment(s)

Help required to extract data from rows to column in Excel2013

Afternoon All,
Second post and a request for help straight away. Hopefully,this ok to post.

Disclaimer – Although I’ve used Excel for years for various reasons, I’ll admit my knowledge of how it works is basic to say the least. I have a few issues that I need help to fix, so I may end up creating separate posts.Anyway, here is a start.

My situation is that I have all data in column 1 of excel. I need to extract this data and place it in an excel spreadsheet. To date there are approx 1000+ rows thatI need to work through. In simpler words -
Extract/Scrape data from multiple rows of Excel (xlsx) sheet 1 into specific distributed column in excel sheet 2 (xlsx).

From Googling, I think, I can see that this is possible by using VBA and macro. I’ve tried working through forum posts and youtubetutorials and to my shame haven’t really been able to extract any data. There could be many reasons for this or it could be that I am such a muppet that the problems is with me. This is why I’ve decided to admit my shortcomings and ask for help. No doubt, even with you good People helping, I’ll get it wrong and have to ask some idiot questions.

I’ve attached a copy of the sheet raw data and processed (expected data sample).
Hopefully, this will helpbut if there’s anything else you or I need, let me know.
So, any help appreciated. I am really hoping that I can learn how to do this as I think we’ll be needing to do more of the same with other information.

Sample in attachment may give more idea.

Attachment 28414
I think Logic of code should be

1) Target sheet to have feilds
STUDENT Subject1 Subject2 Subject3 Subject4 MOST LIKED SUBJECT Explanation
2) write a loop to iterate the rows in sheet1(raw data).
3) For StudentX, copy all next rows till studentX again found in sheet1 and paste in result_sheet - Column wise
STUDENT Subject1 Subject2 Subject3 Subject4 MOST LIKED SUBJECT Explanation
4) Start a new row in sheet2(result_sheet) each time "STUDENT X"
5) repeat loop

Is above correct

Many thanks
Joy

Experts - help please !!

The most obvious problem here is that your sample has a different number of rows for each student. i,e, Student 1 has a name comprising 2 cells, whereas Students 2 & 3 have names comprising 3 cells. If there are no other similar variations in the actual data, the following should work. Excel is not my particular area of expertise and I am sure Excel experts could simplify it, but it should do the job. :)

Code:

Sub TransposeStudentData()Dim lngRec As Long Dim LastRow As Long, NextRow As Long Dim xlSheet As Worksheet, xlSheet2 As Worksheet Dim sName As String Set xlSheet = ActiveSheet Set xlSheet2 = Worksheets.Add With xlSheet2 .Cells(1, 1) = "STUDENT" .Cells(1, 2) = "SUBJECT1" .Cells(1, 3) = "SUBJECT2" .Cells(1, 4) = "SUBJECT3" .Cells(1, 5) = "SUBJECT4" .Cells(1, 6) = "MOST LIKED SUBJECT" .Cells(1, 7) = "EXPLANATION" End With With xlSheet LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row For lngRec = 2 To LastRow Step 15 NextRow = xlSheet2.Cells(xlSheet2.Rows.Count, "A").End(xlUp).Row + 1 If lngRec = 2 Then With xlSheet2 If xlSheet.Cells(lngRec + 3, 1) Like "Subject*" Then .Cells(NextRow, 1) = xlSheet.Cells(lngRec + 1, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 2, 1) .Cells(NextRow, 2) = xlSheet.Cells(lngRec + 4, 1) .Cells(NextRow, 3) = xlSheet.Cells(lngRec + 6, 1) .Cells(NextRow, 4) = xlSheet.Cells(lngRec + 8, 1) .Cells(NextRow, 5) = xlSheet.Cells(lngRec + 10, 1) .Cells(NextRow, 6) = Replace(xlSheet.Cells(lngRec + 11, 1), "MOST LIKED ", "") .Cells(NextRow, 7) = xlSheet.Cells(lngRec + 13, 1) Else .Cells(NextRow, 1) = xlSheet.Cells(lngRec + 1, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 2, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 3, 1) .Cells(NextRow, 2) = xlSheet.Cells(lngRec + 5, 1) .Cells(NextRow, 3) = xlSheet.Cells(lngRec + 7, 1) .Cells(NextRow, 4) = xlSheet.Cells(lngRec + 9, 1) .Cells(NextRow, 5) = xlSheet.Cells(lngRec + 11, 1) .Cells(NextRow, 6) = Replace(xlSheet.Cells(lngRec + 12, 1), "MOST LIKED ", "") .Cells(NextRow, 7) = xlSheet.Cells(lngRec + 14, 1) End If End With Else With xlSheet2 If xlSheet.Cells(lngRec + 2, 1) Like "Subject*" Then .Cells(NextRow, 1) = xlSheet.Cells(lngRec, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 1, 1) .Cells(NextRow, 2) = xlSheet.Cells(lngRec + 3, 1) .Cells(NextRow, 3) = xlSheet.Cells(lngRec + 5, 1) .Cells(NextRow, 4) = xlSheet.Cells(lngRec + 7, 1) .Cells(NextRow, 5) = xlSheet.Cells(lngRec + 9, 1) .Cells(NextRow, 6) = Replace(xlSheet.Cells(lngRec + 10, 1), "MOST LIKED ", "") .Cells(NextRow, 7) = xlSheet.Cells(lngRec + 12, 1) Else .Cells(NextRow, 1) = xlSheet.Cells(lngRec, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 1, 1) & _ Chr(32) & xlSheet.Cells(lngRec + 2, 1) .Cells(NextRow, 2) = xlSheet.Cells(lngRec + 4, 1) .Cells(NextRow, 3) = xlSheet.Cells(lngRec + 6, 1) .Cells(NextRow, 4) = xlSheet.Cells(lngRec + 8, 1) .Cells(NextRow, 5) = xlSheet.Cells(lngRec + 10, 1) .Cells(NextRow, 6) = Replace(xlSheet.Cells(lngRec + 11, 1), "MOST LIKED ", "") .Cells(NextRow, 7) = xlSheet.Cells(lngRec + 13, 1) End If End With End If Next lngRec End With End Sub

Many Many Thanks Graham. Yes, I need to clean up a bit on data. and then let me give it a shot. I am sure it will work with above code. Thank You Again !!