PDA

View Full Version : Help required to extract data from rows to column in Excel2013



joy_joy111
05-06-2021, 03:35 AM
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.

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

joy_joy111
05-06-2021, 04:21 AM
Experts - help please !!

gmayor
05-06-2021, 05:03 AM
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. :)


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

joy_joy111
05-06-2021, 11:42 AM
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 !!