Announcement

Collapse
No announcement yet.

Transposing data... Sort of.

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Transposing data... Sort of.



    Hi everyone!

    My first instinct for this problem was some copy/pasting with 'transpose' BUT I don't think that will cut it. I'm thinking I have to move over to VBA but I've got some questions.


    I have a table of data (larger than the example)
    First Name Last Name Course
    John Smith Math
    John Smith Business
    John Smith Computers
    John Smith Co-Op
    Jen Doe Science
    Jen Doe Math
    Bill Jones Cooking
    Bill Jones Math
    Jen Anderson Science
    that I would like to turn to:
    First Last Course 1 Course 2 Course 3 Course 4 Course 5 Course 6
    John Smith Math Business Computers Co-Op
    Jen Doe Science Math Cooking
    Bill Jones Cooking Math
    Jen Anderson Science
    Is VBA the way to turn for this?

    Any thoughts or pointers to get me going in the right direction?

    Thanks so much!

    Jay

  • #2
    Hello,
    you could use worksheet functions or pivot tables or VBA
    maybe
    Code:
    Option Explicit
    
    Sub testi()
        Dim a(), b(), i As Long, n As Long, t As Long, w
        Dim dic1 As Object
        Set dic1 = CreateObject("Scripting.Dictionary")
        dic1.CompareMode = vbTextCompare
        a = Range("a1").CurrentRegion.Resize(, 3).Value
        ReDim b(1 To UBound(a, 1), 1 To UBound(a))
        For i = 1 To UBound(a, 1)
            If Not dic1.exists(a(i, 1) & " " & a(i, 2)) Then
                n = n + 1
                dic1.Add a(i, 1) & " " & a(i, 2), Array(n, 3)
                b(n, 1) = a(i, 1)
                b(n, 2) = a(i, 2)
                b(n, 3) = a(i, 3)
            Else
                w = dic1(a(i, 1) & " " & a(i, 2))
                b(w(0), w(1) + 1) = a(i, 3)
                w(1) = w(1) + 1
                If w(1) > t Then t = w(1)
                dic1(a(i, 1) & " " & a(i, 2)) = w
            End If
        Next
        Range("G1").Resize(n, t).Value = b
        Set dic1 = Nothing
    End Sub
    If the solution helped please donate to RSPCA

    Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

    Comment


    • #3
      or complete
      Code:
      Option Explicit
      Sub testdb()
          Dim a(), db(), i As Long, n As Long, t As Long, w
          With CreateObject("Scripting.Dictionary")
              .CompareMode = vbTextCompare
              a = Range("a1").CurrentRegion.Resize(, 3).Value
              ReDim db(1 To UBound(a, 1), 1 To UBound(a))
              For i = 1 To UBound(a, 1)
                  If Not .exists(a(i, 1) & " " & a(i, 2)) Then
                      n = n + 1
                      .Add a(i, 1) & " " & a(i, 2), Array(n, 3)
                      db(n, 1) = a(i, 1)
                      db(n, 2) = a(i, 2)
                      db(n, 3) = a(i, 3)
                  Else
                      w = .Item(a(i, 1) & " " & a(i, 2))
                      db(w(0), w(1) + 1) = a(i, 3)
                      w(1) = w(1) + 1
                      If w(1) > t Then
                          t = w(1)
                          db(1, t) = db(1, 3) & " " & t - 2
                      End If
                      .Item(a(i, 1) & " " & a(i, 2)) = w
                  End If
              Next
          End With
          Range("G1").Resize(n, t).Value = db
      
      End Sub
      If the solution helped please donate to RSPCA

      Sites worth visiting: Rabbitohs | Excel-it royUK | Excel Matters Rory | Kris' Spreadsheet Solutions | Domenic xl-central | SO The Macro Man | The Smallman

      Comment


      • #4


        Here's a possible solution using a pivot table, though it's not exactly what you asked for...

        Click image for larger version

Name:	Untitled.png
Views:	1
Size:	92.8 KB
ID:	1205506

        Comment

        Working...
        X