Results 1 to 6 of 6
  1. #1
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts

    rows to cols (2007)

    I have a recurring problem with different school reports in Excel. A list of repeated teacher or student names and a column of associated classes/results etc.

    What I would like to do is:

    If a teacher's name is repeated then the class in the repeat name row gets copied to the next available teacher name row, so that one teacher name appears with a column for each class. Then I want to delete the duplicate teacher rows. It's like normalising the data with unique teacher names.
    I have attached a file as an example with the start of some code, but then I got lost.

    I will have to adapt this to other list that I generate at school. It's like a Pivot table with the rows turned into columns.

    Thanks for help with this. It will save many headaches.
    Attached Files Attached Files

  2. #2
    5 Star Lounger
    Join Date
    Aug 2004
    Location
    Connecticut, USA
    Posts
    816
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: rows to cols (2007)

    Try this macro
    <pre>Sub moveIt()
    Dim strCur As String, lCol As Long, i As Long, iFirst As Long, lastCol As Integer
    Application.ScreenUpdating = False
    i = 1
    Do Until Cells(i, 1) = ""
    If Cells(i, 1) <> strCur Then
    strCur = Cells(i, 1)
    iFirst = Cells(i, 1).Row
    lCol = 3
    i = i + 1
    Else
    lCol = lCol + 1
    If lastCol < lCol Then
    lastCol = lCol
    End If
    Cells(iFirst, lCol) = Cells(i, 3)
    Cells(i, 1).EntireRow.Delete
    i = i

    End If
    Loop

    Cells(1, 3).Select
    Selection.AutoFill Destination:=Range(Cells(1, 3), Cells(1, lastCol)), _
    Type:=xlFillDefault
    Cells(1, 1).Select
    Application.ScreenUpdating = True
    End Sub
    </pre>


  3. #3
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts

    Re: rows to cols (2007)

    Thanks Mike I'll give this a try and get back. I've just tried it and it's magic. Exactly what I want. Now I have to dig in and see how you did it. Thanks your a diamond.

  4. #4
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts

    Re: rows to cols (2007)

    Just one thing I found during my testing.

    If there is a blank row before the code finds any repeats the LastCol remains at 0 and an error appears in this line:

    Selection.AutoFill Destination:=Range(Cells(1, 3), Cells(1, lastCol)), _
    Type:=xlFillDefault

    So I added the code LastCol = LCol +1 in the IF clause and this appears to have cured the problem. Of course if the code does encounter a blank line it quite rightly stops, but it can be re-run from that point.

    Please let me know if I've missed something. Again thanks.

  5. #5
    5 Star Lounger
    Join Date
    Aug 2004
    Location
    Connecticut, USA
    Posts
    816
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: rows to cols (2007)

    The following version assumes that the Full Name and Staff Code could be blank while column C's data is associated with the last filled in Full Name:
    <pre>
    Sub moveIt()
    Dim strCur As String, lCol As Long, i As Long, iFirst As Long, lastCol As Integer
    Application.ScreenUpdating = False
    i = 2: lastCol = 3
    Do Until Cells(i, 3) = ""
    If Cells(i, 1) <> strCur And Cells(i, 1) <> "" Then
    strCur = Cells(i, 1)
    iFirst = Cells(i, 1).Row
    lCol = 3
    i = i + 1
    Else
    lCol = lCol + 1
    If lastCol < lCol Then
    lastCol = lCol
    End If
    Cells(iFirst, lCol) = Cells(i, 3)
    Cells(i, 1).EntireRow.Delete
    i = i

    End If
    Loop

    Cells(1, 3).Select
    Selection.AutoFill Destination:=Range(Cells(1, 3), Cells(1, lastCol)), _
    Type:=xlFillDefault
    Cells(1, 1).Select
    Application.ScreenUpdating = True
    End Sub

    </pre>


  6. #6
    Star Lounger
    Join Date
    Nov 2008
    Location
    England, Yate, Bristol
    Posts
    51
    Thanks
    4
    Thanked 0 Times in 0 Posts

    Re: rows to cols (2007)

    Perfect Mike and much tidier than my effort thanks.

Posting Permissions

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