Results 1 to 4 of 4

Thread: Transpose Data with multiple entries

  1. #1
    Neophyte gmath's Avatar
    Join Date
    Oct 2013
    Location
    Atlanta, GA
    Posts
    2
    Articles
    0

    Question Transpose Data with multiple entries



    Register for a FREE account, and/
    or Log in to avoid these ads!

    I am a little stuck right now, I know there has to be an easy way to do this, but I'm a little out of practice with my VBA, and developing Macros. I was hoping that utilizing Pivot Tables would get me the information I need in the format I would like it, but unfortunately it didn't do what I am looking for. I have a spreadsheet with what I have reduced to 2 columns. Column A has a list of Assembly Numbers, and Column B has a list of Part Numbers used in those assemblies. I want to take column A and remove the duplicates, and take the information in column B and have the Part Numbers that are associated with the assembly "transposed" into the row that lists the assembly.

  2. #2
    Magician NoS's Avatar
    Join Date
    Jan 2013
    Location
    British Columbia
    Posts
    681
    Articles
    0
    Excel Version
    Excel 2010 64bit
    Assuming headers in row 1 try this

    Code:
    Option Explicit
    
    Sub ReArrangeAssemblyParts()
    
        Dim c               'array of unique assembly nums
        Dim rng1 As Range   'original range of assembly nums
        Dim cel1 As Range   'individual cells in rng1
        Dim rng2 As Range   'range where unique assembly nums reside
        Dim cel2 As Range   'individual cells in rng2
        Dim Lrow As Long    'last row used in col A
        Dim i As Long       'column offsets for parts
        
    'make sure on right sheet
    Sheets("Sheet1").Activate
    
    Lrow = Cells(Rows.Count, "A").End(xlUp).Row
    Set rng1 = Range("A2:A" & Lrow)
    
    With CreateObject("scripting.dictionary")
        For Each c In rng1.Value
            .Item(c) = 1
        Next c
        Range("D2").Resize(.Count) = Application.Transpose(.keys)
    End With
    
    Set rng2 = Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
    
    For Each cel2 In rng2
        i = 1
        For Each cel1 In rng1
            If cel1.Value = cel2.Value Then
                cel2.Offset(0, i).Value = cel1.Offset(0, 1).Value
            i = i + 1
            End If
        Next cel1
    Next cel2
    
    End Sub

  3. #3
    Magician Hercules1946's Avatar
    Join Date
    Mar 2013
    Location
    York, England
    Posts
    767
    Articles
    0
    Excel Version
    2010
    Hello Gmath
    I know you've posted in the VBA forum, but there is also a solution to this using formulae:

    1. Use the Advanced Filter (Data tab) to generate a list of unique entries from col A2:, and copy to col D2: (takes a few seconds).
    2. Copy the formula below to Cell E2. Then copy E2 down and across, creating a block deep enough to cover all the unique assembly codes
    and wide enough for the assembly with the largest number of parts. E2:P115 in the example.
    =IF(COUNTIF($A$2:$A$1005,$D2)>COLUMN(A$1)-1,INDEX($B$2:$B$1005,MATCH($D2,$A$2:$A$1005,0)+COLUMN(A$1)-1),"")

    Adjust the arrays to suit your dataset.
    Attached Files Attached Files
    Last edited by Hercules1946; 2013-10-10 at 10:21 PM.

  4. #4
    Neophyte gmath's Avatar
    Join Date
    Oct 2013
    Location
    Atlanta, GA
    Posts
    2
    Articles
    0
    Thanks for your help. I really appreciate it.

Posting Permissions

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