Transpose Columns with Duplicate Values into Single Row

[dabigmonky]

Hello, how can I transpose columns with duplicate values and remove duplicates while placing the remaining values into rows?

Here is what my data looks like:

Here is what I'd like it to look like:

 

[UDIPTI]

Link below as requested:

https://www.dropbox.com/s/lbwzgl7jym7jsyy/mctest101216.xlsm?dl=0

 

[hiker95]

UDIPTI,

Thanks for your workbook/worksheet.

Here is a macro solution for you to consider.

With your data in the ActiveSheet in range A1:B24731, it took 18.461 seconds to process the data, into the resulting range A1:K3119.


Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Sub ReorgData_UDIPTI()
' hiker95, 10/12/2016, ME819244
Dim r As Long, lr As Long, n As Long, lc As Long
Application.ScreenUpdating = False
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  For r = 2 To lr
    n = Application.CountIf(.Columns(1), .Cells(r, 1).Value)
    If n > 1 Then
      .Cells(r, 2).Resize(, n).Value = Application.Transpose(.Range(.Cells(r, 2), .Cells(r + n - 1, 2)).Value)
      .Range("A" & r + 1 & ":B" & r + n - 1).ClearContents
    End If
    r = r + n - 1
  Next r
  lc = .Cells.Find("*", , xlValues, xlWhole, xlByColumns, xlPrevious, False).Column
  On Error Resume Next
  .Range("A1", .Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  On Error GoTo 0
  .Cells(1, 3).Resize(, lc - 2).Value = .Cells(1, 2).Value
  .Columns(1).Resize(, lc).AutoFit
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData_UDIPTI macro.


I would think that one of the Scripting.Dictionary Gurus would be able to create a much faster macro.

 

[UDIPTI]

Hiker95,

Thank you very much! I tested it on a few files with 100% success!

 

[hiker95]

UDIPTI,

Thanks for the feedback.

You are very welcome. Glad I could help.

And, come back anytime.