Transpose Columns with Duplicate Values into Single Row

dabigmonky

New Member
Joined
Nov 14, 2014
Messages
8
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:

Image%202014-11-19%20at%209.35.15%20AM.png


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

Image%202014-11-19%20at%209.37.59%20AM.png
 

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
maybe something like...

Excel 2012[TABLE="class: grid, width: 500"]
<tbody>[TR="bgcolor: #DAE7F5"]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]D[/TD]
[TD]E[/TD]
[TD]F[/TD]
[/TR]
[TR]
[TD="align: center"]1[/TD]
[TD="bgcolor: #FFFF00"]Kit[/TD]
[TD="bgcolor: #FFFF00"]Component[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]2[/TD]
[TD]ABC[/TD]
[TD]S001[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]3[/TD]
[TD]ABC[/TD]
[TD]S002[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]4[/TD]
[TD]ABC[/TD]
[TD]S003[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]5[/TD]
[TD]DEF[/TD]
[TD]S006[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]6[/TD]
[TD]DEF[/TD]
[TD]S007[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]7[/TD]
[TD]DEF[/TD]
[TD]S008[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]8[/TD]
[TD]DEF[/TD]
[TD]S009[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]9[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]10[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: center"]11[/TD]
[TD]ABC[/TD]
[TD]S001[/TD]
[TD]S002[/TD]
[TD]S003[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD="align: center"]12[/TD]
[TD]DEF[/TD]
[TD]S006[/TD]
[TD]S007[/TD]
[TD]S008[/TD]
[TD]S009[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Sheet1

[TABLE="width: 85%"]
<tbody>[TR]
[TD]Worksheet Formulas[TABLE="width: 100%"]
<tbody>[TR="bgcolor: #DAE7F5"]
[TH]Cell[/TH]
[TH="align: left"]Formula[/TH]
[/TR]
[TR]
[TH="bgcolor: #DAE7F5"]B11[/TH]
[TD="align: left"]=IFERROR(INDEX($B$2:$B$8,AGGREGATE(15,6,(ROW($A$2:$A$8)-ROW($A$2)+1)/($A$2:$A$8=$A11),COLUMNS($B11:B11))),"")[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
Code:
Sub myMacro()
    i = 2
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Do Until i > lastRow
        ii = i
        Do Until ii > lastRow
            If ii = i Then
                c = 3
            ElseIf Cells(ii, 1).Value = Range("A" & i).Value
                Cells(i, c).Value = Range("B" & ii).Value
                c = c + 1
                Rows(ii).Delete
                ii = ii - 1
                lastRow = Range("A" & Rows.Count).End(xlUp).Row
            End If
            ii = ii + 1
        Loop
        i = i + 1
    Loop
End Sub
 
Upvote 0
Code:
Sub myMacro()
    i = 2
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    Do Until i > lastRow
        ii = i
        Do Until ii > lastRow
            If ii = i Then
                c = 3
            ElseIf Cells(ii, 1).Value = Range("A" & i).Value
                Cells(i, c).Value = Range("B" & ii).Value
                c = c + 1
                Rows(ii).Delete
                ii = ii - 1
                lastRow = Range("A" & Rows.Count).End(xlUp).Row
            End If
            ii = ii + 1
        Loop
        i = i + 1
    Loop
End Sub

I received a "Compile Error: Syntax Error"
ElseIf Cells(ii, 1).Value = Range("A" & i).Value
 
Upvote 0
dabigmonky,

With you raw data already sorted/grouped by the Kit's in column A.

Sample raw data:


Excel 2007
ABCDE
1KitComponent
2ABCS001
3ABCS002
4ABCS003
5DEFS006
6DEFS007
7DEFS008
8DEFS009
9
Sheet1


After the macro, and, function:


Excel 2007
ABCDE
1KitComponentComponentComponentComponent
2ABCS001S002S003
3DEFS006S007S008S009
4
5
6
7
8
9
Sheet1


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).

1. Copy the below code, and, function
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub ReorgData()
' hiker95, 11/19/2014, ME819244
Dim o As Variant, j As Long, c As Long, mc As Long
Dim Rng As Range, nlr As Long
Dim r As Long, lr As Long, rr As Long, sr As Long, er As Long, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lr)
nlr = CountUnique(Rng)
ReDim o(1 To nlr, 1 To lr)
For r = 2 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  If n > mc Then mc = n
  If n = 1 Then
    j = j + 1
    o(j, 1) = Cells(r, 1).Value: o(j, 2) = Cells(r, 2).Value
  ElseIf n > 1 Then
    j = j + 1
    o(j, 1) = Cells(r, 1).Value: o(j, 2) = Cells(r, 2).Value
    c = 3
    sr = r + 1: er = sr + n - 2
    For rr = sr To er
      o(j, c) = Cells(rr, 2).Value
      c = c + 1
    Next rr
  End If
  r = r + n - 1
Next r
Range("A2:B" & lr).ClearContents
Cells(1, 3).Resize(, mc - 1).Value = Cells(1, 2).Value
Range("A2").Resize(UBound(o, 1), UBound(o, 2)).Value = o
Columns(1).Resize(, 2 + mc).AutoFit
Application.ScreenUpdating = True
End Sub
Function CountUnique(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro, and, function, with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.
 
Upvote 0
dabigmonky,

With you raw data already sorted/grouped by the Kit's in column A.

Sample raw data:

Excel 2007
ABCDE
KitComponent

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF"]ABC[/TD]
[TD="bgcolor: #FFFFFF"]S001[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF"]ABC[/TD]
[TD="bgcolor: #FFFFFF"]S002[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF"]ABC[/TD]
[TD="bgcolor: #FFFFFF"]S003[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FFFFFF"]DEF[/TD]
[TD="bgcolor: #FFFFFF"]S006[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FFFFFF"]DEF[/TD]
[TD="bgcolor: #FFFFFF"]S007[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FFFFFF"]DEF[/TD]
[TD="bgcolor: #FFFFFF"]S008[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: #FFFFFF"]DEF[/TD]
[TD="bgcolor: #FFFFFF"]S009[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

</tbody>
Sheet1



After the macro, and, function:

Excel 2007
ABCDE
KitComponent

<colgroup><col style="width: 25pxpx"><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]1[/TD]

[TD="bgcolor: #FFFFFF, align: right"]Component[/TD]
[TD="bgcolor: #FFFFFF, align: right"]Component[/TD]
[TD="bgcolor: #FFFFFF, align: right"]Component[/TD]

[TD="align: center"]2[/TD]
[TD="bgcolor: #FFFFFF"]ABC[/TD]
[TD="bgcolor: #FFFFFF"]S001[/TD]
[TD="bgcolor: #FFFFFF, align: right"]S002[/TD]
[TD="bgcolor: #FFFFFF, align: right"]S003[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]3[/TD]
[TD="bgcolor: #FFFFFF"]DEF[/TD]
[TD="bgcolor: #FFFFFF"]S006[/TD]
[TD="bgcolor: #FFFFFF, align: right"]S007[/TD]
[TD="bgcolor: #FFFFFF, align: right"]S008[/TD]
[TD="bgcolor: #FFFFFF, align: right"]S009[/TD]

[TD="align: center"]4[/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]5[/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]6[/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]7[/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]8[/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

[TD="align: center"]9[/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]
[TD="bgcolor: #FFFFFF, align: right"][/TD]

</tbody>
Sheet1



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).

1. Copy the below code, and, function
2. Open your NEW workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub ReorgData()
' hiker95, 11/19/2014, ME819244
Dim o As Variant, j As Long, c As Long, mc As Long
Dim Rng As Range, nlr As Long
Dim r As Long, lr As Long, rr As Long, sr As Long, er As Long, n As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = Range("A2:A" & lr)
nlr = CountUnique(Rng)
ReDim o(1 To nlr, 1 To lr)
For r = 2 To lr
  n = Application.CountIf(Columns(1), Cells(r, 1).Value)
  If n > mc Then mc = n
  If n = 1 Then
    j = j + 1
    o(j, 1) = Cells(r, 1).Value: o(j, 2) = Cells(r, 2).Value
  ElseIf n > 1 Then
    j = j + 1
    o(j, 1) = Cells(r, 1).Value: o(j, 2) = Cells(r, 2).Value
    c = 3
    sr = r + 1: er = sr + n - 2
    For rr = sr To er
      o(j, c) = Cells(rr, 2).Value
      c = c + 1
    Next rr
  End If
  r = r + n - 1
Next r
Range("A2:B" & lr).ClearContents
Cells(1, 3).Resize(, mc - 1).Value = Cells(1, 2).Value
Range("A2").Resize(UBound(o, 1), UBound(o, 2)).Value = o
Columns(1).Resize(, 2 + mc).AutoFit
Application.ScreenUpdating = True
End Sub
Function CountUnique(ByVal Rng As Range) As Long
' Juan Pablo González, MrExcel MVP, 05/09/2003
' http://www.mrexcel.com/forum/excel-questions/48385-need-count-unique-items-column-visual-basic-applications.html
Dim St As String
Set Rng = Intersect(Rng, Rng.Parent.UsedRange)
St = "'" & Rng.Parent.Name & "'!" & Rng.Address(False, False)
CountUnique = Evaluate("SUM(IF(LEN(" & St & "),1/COUNTIF(" & St & "," & St & ")))")
End Function

Before you use the macro, and, function, with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the ReorgData macro.


Is there any limitations to this script. I have used it a few times before with no issues. Here is an example of the data I am trying to use. There is 24,000 Records with no more than 16 unique items.

[TABLE="width: 205"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD][TABLE="width: 205"]
<colgroup><col><col></colgroup><tbody>[TR]
[TD]ITEM[/TD]
[TD]NUMBER[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101300100[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101300200[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101400100[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101400200[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101500100[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101500200[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101600100[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]L012101600200[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102300100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102300200[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102400100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102400200[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102500100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102500200[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102600100[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD]L012102600200[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


I get an error that says run-time error '1004': Application-defined or object-defined error. When I debug it highlights this line: Range("A2").Resize(UBound(o, 1), UBound(o, 2)).Value = o

Any idea why this is happening. I appreciate the help :)
 
Upvote 0
UDIPTI,

1. What version of Excel and Windows are you using?

2. Are you using a PC or a Mac?

3. Are your ITEM numbers in column A, beginning in cell A2, grouped and sorted together?

4. Are there any blank cells/rows in your raw data?
 
Upvote 0
UDIPTI,

1. What version of Excel and Windows are you using?
  • Excel 2013 & Windows 7

2. Are you using a PC or a Mac?

  • PC

3. Are your ITEM numbers in column A, beginning in cell A2, grouped and sorted together?
  • Yes the item numbers begin in A2 and are grouped and sorted together.

4. Are there any blank cells/rows in your raw data?
  • No there are no blank cells/rows in the raw data.

I uploaded the list to a google doc if you would like to take a look.

https://docs.google.com/spreadsheets/d/1Y0zBFamWjGaFUzHQWbB4Kqp79N1HFEGVWIpXXGYyLC8/edit?usp=sharing
 
Upvote 0

Forum statistics

Threads
1,223,239
Messages
6,170,947
Members
452,368
Latest member
jayp2104

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top