Consulting

Results 1 to 4 of 4

Thread: Help required to extract data from rows to column in Excel2013

  1. #1

    Lightbulb Help required to extract data from rows to column in Excel2013

    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.

    111Excel REq.jpg
    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
    Attached Files Attached Files

  2. #2
    Experts - help please !!

  3. #3
    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
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  4. #4
    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 !!

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •