Note: The other languages of the website are Google-translated. Back to English
Inloggen  \/ 
x
or
x
Registreer  \/ 
x

or

 Hoe cellen in een kolom transponeren op basis van unieke waarden in een andere kolom?

Stel dat u een gegevensbereik heeft dat twee kolommen bevat, nu wilt u cellen in één kolom transponeren naar horizontale rijen op basis van unieke waarden in een andere kolom om het volgende resultaat te krijgen. Heeft u goede ideeën om dit probleem in Excel op te lossen?

doc transponeren unieke waarden 1

Transponeer cellen in één kolom op basis van unieke waarden met formules

Transponeer cellen in één kolom op basis van unieke waarden met VBA-code

Transponeer cellen in één kolom op basis van unieke waarden met Kutools voor Excel


Met de volgende matrixformules kunt u de unieke waarden extraheren en de bijbehorende gegevens in horizontale rijen transponeren, doe dit als volgt:

1. Voer deze matrixformule in: = INDEX ($ A $ 2: $ A $ 16, MATCH (0, AANTAL.ALS ($ D $ 1: $ D1, $ A $ 2: $ A $ 16), 0)) in een lege cel, bijvoorbeeld D2, en druk op Shift + Ctrl + Enter toetsen samen om het juiste resultaat te krijgen, zie screenshot:

doc transponeren unieke waarden 2

Opmerking:: In de bovenstaande formule, A2: A16 is de kolom waarvan u de unieke waarden wilt weergeven, en D1 is de cel boven deze formulecel.

2. Sleep vervolgens de vulgreep naar de cellen om alle unieke waarden te extraheren, zie screenshot:

doc transponeren unieke waarden 3

3. En ga dan verder met het invoeren van deze formule in cel E2: =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0), en vergeet niet om op te drukken Shift + Ctrl + Enter toetsen om het resultaat te krijgen, zie screenshot:

doc transponeren unieke waarden 4

Opmerking:: In bovenstaande formule: B2: B16 zijn de kolomgegevens die u wilt transponeren, A2: A16 is de kolom waarop u de waarden wilt transponeren op basis van, en D2 bevat de unieke waarde die u in stap 1 heeft geëxtraheerd.

4. Sleep vervolgens de vulgreep naar rechts van de cellen waarvan u de getransponeerde gegevens wilt weergeven totdat 0 wordt weergegeven, zie screenshot:

doc transponeren unieke waarden 5

5. En ga vervolgens door met het slepen van de vulgreep naar het celbereik om de getransponeerde gegevens te krijgen zoals in het volgende screenshot:

doc transponeren unieke waarden 6


Misschien zijn de formules ingewikkeld om te begrijpen, hier kunt u de volgende VBA-code uitvoeren om het gewenste resultaat te krijgen dat u nodig hebt.

1. Houd de ALT + F11 toetsen om de te openen Microsoft Visual Basic voor toepassingen venster.

2. Klikken Invoegen > Moduleen plak de volgende code in het Module Venster.

VBA-code: transponeer cellen in één kolom op basis van unieke waarden in een andere kolom:

Sub transposeunique()
'updateby Extendoffice
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCol  As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
       (xRg.Areas.Count > 1) Then
        MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
        Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
        xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
        xCrit = xCol.Item(i)
        xOutRg.Offset(i, 0) = xCrit
        xRg.AutoFilter Field:=1, Criteria1:=xCrit
        Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
        If xVRg.Count > xCount Then xCount = xVRg.Count
        xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
        xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        Application.CutCopyMode = False
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
End Sub

3. Druk vervolgens op F5 toets om deze code uit te voeren, en er verschijnt een promptvenster om u eraan te herinneren het gegevensbereik te selecteren dat u wilt gebruiken, zie screenshot:

doc transponeren unieke waarden 7

4. En klik vervolgens op OK knop, verschijnt er een ander promptvenster om u eraan te herinneren een cel te selecteren om het resultaat te plaatsen, zie screenshot:

doc transponeren unieke waarden 8

6. Klikken OK knop, en de gegevens in kolom B zijn getransponeerd op basis van unieke waarden in kolom A, zie screenshot:

doc transponeren unieke waarden 9


Als je Kutools for Excel, het combineren van de Geavanceerd Combineer rijen als Gespleten cellen hulpprogramma's, kunt u deze taak snel voltooien zonder formules of code.

Kutools for Excel : met meer dan 300 handige Excel-invoegtoepassingen, gratis te proberen zonder beperking in 30 dagen.

Na het installeren van Kutools for Excelgaat u als volgt te werk:

1. Selecteer het gegevensbereik dat u wilt gebruiken. (Als u de originele gegevens wilt behouden, kopieer en plak de gegevens dan eerst op een andere locatie.)

2. Dan klikken Kutools > Samenvoegen en splitsen > Geavanceerd Combineer rijen, zie screenshot:

3. In de Combineer rijen op basis van kolom dialoogvenster, voer dan de volgende bewerkingen uit:

(1.) Klik op de kolomnaam waarop u gegevens wilt transponeren op basis van en selecteer Hoofdsleutel;

(2.) Klik op een andere kolom die u wilt transponeren, en klik Combineren Kies vervolgens een scheidingsteken om de gecombineerde gegevens te scheiden, zoals spatie, komma, puntkomma.

doc transponeren unieke waarden 11

4. Dan klikken Ok knop, zijn de gegevens in kolom B gecombineerd in één cel op basis van kolom A, zie screenshot:

doc transponeren unieke waarden 12

5. En selecteer vervolgens de gecombineerde cellen en klik Kutools > Samenvoegen en splitsen > Gespleten cellen, zie screenshot:

6. In de Gespleten cellen dialoogvenster, selecteer Splitsen in kolommen onder de Type optie en kies vervolgens het scheidingsteken dat uw gecombineerde gegevens scheidt, zie screenshot:

doc transpose unieke waarden 14 14

7. Dan klikken Ok knop en selecteer een cel om het gesplitste resultaat in het uitgeklapte dialoogvenster te plaatsen, zie screenshot:

doc transponeren unieke waarden 15

8. Klikken OK, en je krijgt het resultaat zoals je nodig hebt. Zie screenshot:

doc transponeren unieke waarden 16

Download en gratis proef Kutools voor Excel nu!


Kutools for Excel: met meer dan 300 handige Excel-invoegtoepassingen, gratis te proberen zonder beperking in 30 dagen. Download en probeer nu gratis!

De beste tools voor kantoorproductiviteit

Kutools voor Excel lost de meeste van uw problemen op en verhoogt uw productiviteit met 80%

  • visfuik: Snel invoegen complexe formules, grafieken en alles wat je eerder hebt gebruikt; Versleutel cellen met wachtwoord; Maak een mailinglijst en stuur e-mails ...
  • Super Formula-balk (bewerk eenvoudig meerdere regels tekst en formule); Lay-out lezen (gemakkelijk grote aantallen cellen lezen en bewerken); Plakken in gefilterd bereik...
  • Voeg cellen / rijen / kolommen samen zonder gegevens te verliezen; Gespleten cellen inhoud; Combineer dubbele rijen / kolommen... Voorkom dubbele cellen; Vergelijk Ranges...
  • Selecteer Dupliceren of Uniek Rijen; Selecteer lege rijen (alle cellen zijn leeg); Super zoeken en fuzzy zoeken in veel werkboeken; Willekeurige selectie ...
  • Exacte kopie Meerdere cellen zonder de formuleverwijzing te wijzigen; Maak automatisch verwijzingen naar meerdere bladen; Plaats kogels, Selectievakjes en meer ...
  • Extraheer tekst, Tekst toevoegen, Verwijderen op positie, Ruimte verwijderen; Paging-subtotalen maken en afdrukken; Converteren tussen celinhoud en opmerkingen...
  • Super filter (bewaar en pas filterschema's toe op andere bladen); Geavanceerd sorteren per maand / week / dag, frequentie en meer; Speciaal filter door vet, cursief ...
  • Combineer werkmappen en werkbladen; Tabellen samenvoegen op basis van sleutelkolommen; Gegevens splitsen in meerdere bladen; Batch Converteer xls, xlsx en PDF...
  • Meer dan 300 krachtige functies. Ondersteunt Office / Excel 2007-2019 en 365. Ondersteunt alle talen. Eenvoudig te implementeren in uw onderneming of organisatie. Gratis proefperiode van 30 dagen met volledige functies. 60 dagen geld-terug-garantie.
kte tabblad 201905

Office-tabblad Brengt een interface met tabbladen naar Office en maakt uw werk veel gemakkelijker

  • Schakel bewerken en lezen met tabbladen in Word, Excel, PowerPoint in, Publisher, Access, Visio en Project.
  • Open en maak meerdere documenten in nieuwe tabbladen van hetzelfde venster in plaats van in nieuwe vensters.
  • Verhoogt uw productiviteit met 50% en vermindert elke dag honderden muisklikken voor u!
officetab onderkant
Say something here...
symbols left.
You are guest
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    Alex · 6 days ago
    how would you do the first order but with multiple columns of data for each product? Like if KTO and KTE had multiple pieces of data in columns C, D, E,...

    This was the formula used:

    =IFERROR(INDEX($B$2:$B$16, MATCH(0, COUNTIF($D2:D2,$B$2:$B$16)+IF($A$2:$A$16<>$D2, 1, 0), 0)), 0)
  • To post as a guest, your comment is unpublished.
    Harish · 1 months ago
    thanks !! just what i was looking for !! works as intended !!
  • To post as a guest, your comment is unpublished.
    Gregg · 1 years ago
    this was a very, very helpful post - thank you!
    I found the VBA version did not yield the expected results at least when running in VBA 7.1 (Excel for Office 365 - 16.0.x - 64-bit). I tweaked it a bit to get the results I wanted:


    Sub transposeunique()
    'updateby Extendoffice
    'updateby skipow June 2020
    Dim xLRow As Long
    Dim i As Long
    Dim xCrit As String
    Dim xCritLast As String
    Dim xCol As New Collection
    Dim xRg As Range
    Dim xOutRg As Range
    Dim xTxt As String
    Dim xCount As Long
    Dim xVRg As Range
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("please select data range(only two columns):", "Kutools for Excel", xTxt, , , , , 8)
    Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
    If xRg Is Nothing Then Exit Sub
    If (xRg.Columns.Count <> 2) Or _
    (xRg.Areas.Count > 1) Then
    MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
    Exit Sub
    End If
    Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
    If xOutRg Is Nothing Then Exit Sub
    Set xOutRg = xOutRg.Range(1)
    xLRow = xRg.Rows.Count
    For i = 2 To xLRow
    'xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
    'the above line commented out - the Add function to the Collection (at least in VBA 7.1) doesn't accept this format
    xCol.Add Item:=xRg.Cells(i, 1).Value
    'you only need the first column put into the Collection

    Next
    Application.ScreenUpdating = False
    For i = 1 To xCol.Count
    xCrit = xCol.Item(i)
    'if you don't keep track of the last entry and compare to the next entry you'll get duplicate lines
    If xCrit = xCritLast Then
    xRg.AutoFilter
    Else
    xOutRg.Offset(i, 0) = xCrit
    xRg.AutoFilter Field:=1, Criteria1:=xCrit
    Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
    If xVRg.Count > xCount Then xCount = xVRg.Count
    xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible).Copy
    xOutRg.Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
    'save the last entry and compare above to the next one to avoid duplicates
    xCritLast = xCrit
    End If
    Next
    xOutRg = xRg.Cells(1, 1)
    xOutRg.Offset(0, 1).Resize(1, xCount) = xRg.Cells(1, 2)
    xRg.Rows(1).Copy
    xOutRg.Resize(1, xCount + 1).PasteSpecial Paste:=xlPasteFormats
    xRg.AutoFilter
    Application.ScreenUpdating = True
    End Sub

    • To post as a guest, your comment is unpublished.
      Zoe · 1 months ago
      This works, but it gives me duplicates. Is there a way to make it not?
      • To post as a guest, your comment is unpublished.
        Harish · 1 months ago
        it worked for me, i had to sort the first column though
  • To post as a guest, your comment is unpublished.
    ygoyal578@gmail.com · 1 years ago
    can you please share the code if there are 2 columns to be copied instead of 1. below is the example.
  • To post as a guest, your comment is unpublished.
    gabimargareta204@gmail.com · 1 years ago
    I have a data set which has 3 columns presented below:

    Column A Column B Column C

    Country1 Year1 Value1
    Country1 Year2 Value2
    Country1 Year3 Value3,

    Country2 Year1 Value1
    Country2 Year3 Value3,
    ...........

    I need to combine these 3 columns in a table like this:

    Year1 Year2 Year3 ................................. YearX


    Country1 Value1 Value2 Value3
    Country2 Value1 #Missing Value3
    .....
    .....
    .....
    CountryX Valuex ..................



    The problem i am facing is that for some data in column A i don't have values for each year only for some.(For example country 2 has missing values for Year 2)


    Is there a way to work around this issue and resolve it?

    Thank you in advance!
  • To post as a guest, your comment is unpublished.
    emsequeira · 2 years ago
    I have a data set which has multiple IDs in column A, and has connected data in column B. I used the above formula and altered it a bit so that I am transposing the cells in the column B into a row based on the unique ID tied to it in column A. The formula used to identify the unique IDs is: =INDEX($A$2:$A$13409, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$13409), 0)). The formula used to do the transposing is: =IFERROR(INDEX($B$2:$B$13409, MATCH(0, IF($A$2:$A$13409<>$D2, 1, 0)+COUNTIF($D2:D2,$B$2:$B$13409), 0)), "N/A"). Both given in the article, only slightly altered.

    The issue is my data set in column B has duplicates, sometimes appearing one after another, and I need all of the values in the column to be presented in the rows.

    The image attached is what I would like the table to show (this is a small sample size, the true dataset has over 13,000 entries). What is happening now is when a repeat value is encountered, it will not count it.
    i.e. Row 9 for ID 11980 now only shows 0 -31.79 -0.19 -0.74 N/A N/A .... when what I need it to show instead is 0 0 -31.79 -0.19 -0.74 0 0 N/A N/A ....

    Is there a way to work around this issue and resolve it?

    Thank you in advance!
  • To post as a guest, your comment is unpublished.
    ariellerazzy · 2 years ago
    I have a data set in Columns A (Unique ID) - E. Each row has data based on the ID#, there are multiple rows for each ID# but I want one row per ID# with all of the other data in columns (it would be 5 columns long minimum and 25 maximum depending on how many each unique ID has). I found a code but it only works for two columns. I had to concatenate the four columns (not including ID) then delimit after running the macro (lot of work). For 15,000 rows of data this is extra time consuming. Is there an endless column macro that would work? Thanks in advance everyone for your help!
    ID CODE ST CODE# DATE
  • To post as a guest, your comment is unpublished.
    martha Bright · 2 years ago
    The macro did not work. It just copied the contents in cell A1.
  • To post as a guest, your comment is unpublished.
    Vinod · 2 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of A column into a new column BUT...is there a way to get the all the values in B column to be transposed as given below:

    Product Order Date Product Order Order Order Order Order Order Order
    KTE 100 3/3/2019 KTE 100 100 100 200 100 150 100
    KTO 150 3/3/2019 KTO 150 100 200 100 150 200
    KTE 100 3/4/2019 BOT 150 100 200 150 100 200
    KTO 100 3/4/2019 COD 200 150 100 150
    KTO 200 3/5/2019
    KTE 100 3/5/2019
    BOT 150 3/5/2019
    BOT 100 3/6/2019
    KTO 100 3/6/2019
    KTE 200 3/6/2019
    BOT 200 3/7/2019
    COD 200 3/7/2019
    KTE 100 3/7/2019
    KTO 150 3/7/2019
    BOT 150 3/8/2019
    KTE 150 3/8/2019
    COD 150 3/8/2019
    BOT 100 3/9/2019
    BOT 200 3/10/2019
    COD 100 3/10/2019
    KTO 200 3/10/2019
    COD 150 3/11/2019
    KTE 100 3/11/2019
  • To post as a guest, your comment is unpublished.
    seanviz18@gmail.com · 2 years ago
    So I am working for a company. We have columns for info such as Last name, first name, rank, section, phone number, address. Is there a way I can use a similar formula to transpose the entire row of info to a column by names?
  • To post as a guest, your comment is unpublished.
    kumar · 2 years ago
    Hi can we add each row and give the output in one column, with the above functionality.
  • To post as a guest, your comment is unpublished.
    raj · 2 years ago
    Need to get the same out put but for predefined columns to be selected would be ($A,$B) and need the output column Position on $D$1.
    If any one have idea's that would be a great help!!!!
  • To post as a guest, your comment is unpublished.
    Kate · 3 years ago
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) worked for me to transpose the unique values of a column into a new column BUT...is there a way to ad in a sort function so that the new column created is transposed in ascending order?


    Thanks!
  • To post as a guest, your comment is unpublished.
    Prial · 3 years ago
    Same as Dave, I need to do the exactly opposite of this. Table 2 to transpose to Table 1. Input Table 2, Output Table 1.
  • To post as a guest, your comment is unpublished.
    dababler@gmail.com · 3 years ago
    I need to do exactly the opposite of this. I have many many columns associated with a row id and I want to paste them into two columns
    for example I have
    rowid, value, value1, value2, value3, value4, value..225
    100, Dolphin, 255, 9--, sarah, jameson, ....
    179, Router, flood, jason, 89, nose



    I want it to look like this
    100, Dolphin
    100, 255
    100, 9--
    100, sarah
    100, jaemeson
    179, Router
    179, flood
    179, jason
    179, 89
    179, nose
    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hello, Dave,
      To solve your problem, please use the below VBA code: (Note: When you select the data range that you want to transpose, please exclude the header row.)

      Sub TransposeUnique_2()
      Dim xLRow, xLCount As Long
      Dim xRg As Range
      Dim xOutRg As Range
      Dim xObjRRg As Range
      Dim xTxt As String
      Dim xCount As Long
      Dim xVRg As Range
      On Error Resume Next
      xTxt = ActiveWindow.RangeSelection.Address
      Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
      Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
      If xRg Is Nothing Then Exit Sub
      If (xRg.Rows.count < 2) Or _
      (xRg.Areas.count > 1) Then
      MsgBox "Invalid selection", , "Kutools for Excel"
      Exit Sub
      End If
      Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
      If xOutRg Is Nothing Then Exit Sub
      Application.ScreenUpdating = False
      xLCount = xRg.Columns.count
      For xLRow = 1 To xRg.Rows.count
      Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
      xObjRRg.Copy
      xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Application.CutCopyMode = False
      Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
      Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
      Next
      Application.ScreenUpdating = True
      End Sub
      • To post as a guest, your comment is unpublished.
        ygoyal578@gmail.com · 1 years ago
        Hello Skyyang,
        please share the code for 3 columns. Below is the example:

        I want the data like: yogesh@gmail.com community 1 view only community 2 view only ......
        goyal@gmail.com community 1 view only community 2 view only........

        • To post as a guest, your comment is unpublished.
          skyyang · 1 years ago
          Hello, ygoyal,
          To solve your problem, please apply the below code:
          Sub TransposeUnique_2()
          Dim xLRow, xLCount As Long
          Dim xRg As Range
          Dim xOutRg As Range
          Dim xObjRRg As Range
          Dim xTxt As String
          Dim xCount As Long
          Dim xVRg As Range
          Dim xC, xI, xI1, xI2 As Integer
          On Error Resume Next
          xTxt = ActiveWindow.RangeSelection.Address
          Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
          Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
          If xRg Is Nothing Then Exit Sub
          If (xRg.Rows.Count < 2) Or _
          (xRg.Areas.Count > 1) Then
          MsgBox "Invalid selection", , "Kutools for Excel"
          Exit Sub
          End If
          Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
          If xOutRg Is Nothing Then Exit Sub
          Application.ScreenUpdating = False
          xLCount = xRg.Columns.Count
          For xLRow = 1 To xRg.Rows.Count
          Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
          On Error Resume Next
          xC = (xObjRRg.Count Mod 2)
          If xC <> 0 Then
          xC = Int(xObjRRg.Count / 2) + 1
          Else
          xC = Int(xObjRRg.Count / 2)
          End If
          xI1 = 1
          xI2 = 2
          For xI = 1 To xC
          Range(xObjRRg.Item(xI1), xObjRRg.Item(xI2)).Copy
          xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
          Application.CutCopyMode = False
          xOutRg.Value = xRg.Cells(xLRow, 1).Value
          Set xOutRg = xOutRg.Offset(RowOffset:=1)
          xI1 = xI1 + (2)
          xI2 = xI2 + (2)
          Next
          Next
          Application.ScreenUpdating = True
          End Sub

          Please try, hope it can help you!
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, still waiting for your help
          • To post as a guest, your comment is unpublished.
            Yogesh · 1 years ago
            Bro, pls help in this.
          • To post as a guest, your comment is unpublished.
            ygoyal578@gmail.com · 1 years ago
            Hello Bro, The code is working opposite. Please refer the attached screen shot of requirement.
            The data available is row-wise and want to transpose the data in columns .
            • To post as a guest, your comment is unpublished.
              skyyang · 1 years ago
              Hi, ygoyal,
              Sorry for replying late, please apply the following code, please try it!

              Sub transposeunique()
              'updateby Extendoffice
              Dim xLRow As Long
              Dim i As Long
              Dim xCrit As String
              Dim xCol As New Collection
              Dim xRg As Range
              Dim xOutRg As Range
              Dim xTxt As String
              Dim xCount As Long
              Dim xVRg As Range
              Dim xFRg, xSRg, xCRg As Range
              On Error Resume Next
              xTxt = ActiveWindow.RangeSelection.Address
              Set xRg = Application.InputBox("please select data range(only 3 columns):", "Kutools for Excel", xTxt, , , , , 8)
              Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
              If xRg Is Nothing Then Exit Sub
              If (xRg.Columns.Count <> 3) Or _
              (xRg.Areas.Count > 1) Then
              MsgBox "the used range is only one area with two columns ", , "Kutools for Excel"
              Exit Sub
              End If
              Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
              If xOutRg Is Nothing Then Exit Sub
              Set xOutRg = xOutRg.Range(1)
              xLRow = xRg.Rows.Count
              For i = 2 To xLRow
              xCol.Add xRg.Cells(i, 1).Value, xRg.Cells(i, 1).Value
              Next
              Application.ScreenUpdating = False
              Application.ScreenUpdating = False
              For i = 1 To xCol.Count
              xCrit = xCol.Item(i)
              xOutRg.Offset(i, 0) = xCrit
              xRg.AutoFilter Field:=1, Criteria1:=xCrit
              Set xVRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              If xVRg.Count > xCount Then xCount = xVRg.Count
              Set xSRg = xRg.Range("B2:B" & xLRow).SpecialCells(xlCellTypeVisible)
              Set xCRg = xOutRg.Offset(i, 1)
              For Each xFRg In xSRg
              xFRg.Copy
              xCRg.PasteSpecial
              xRg.Range("B1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              xFRg.Offset(0, 1).Copy
              Set xCRg = xCRg.Offset(0, 1)
              xCRg.PasteSpecial
              xRg.Range("c1").Copy
              xCRg.Offset(-(i), 0).PasteSpecial
              Set xCRg = xCRg.Offset(0, 1)
              Next
              Application.CutCopyMode = False
              Next
              xRg.Item(1).Copy
              xOutRg.PasteSpecial
              xRg.AutoFilter
              Application.ScreenUpdating = True
              End Sub
              • To post as a guest, your comment is unpublished.
                carlos7z · 6 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                carlos7z · 6 months ago
                Hi Skyyang, Love this, any chance you could get it to work for four columns? again just using the first two as a comparator, or better still the ability to choose the number of columns before selecting them? I took a look at your script, wouldn't have a clue on how to achieve this...
              • To post as a guest, your comment is unpublished.
                ygoyal578@gmail.com · 1 years ago
                Hey Bro I tried using this code but the excel goes hang when I run this code and could not see the output from the above code. please suggest what to do in this case.
                • To post as a guest, your comment is unpublished.
                  skyyang · 1 years ago
                  Hi,
                  The code works well in my workbook, which Excel version do you use?
                  • To post as a guest, your comment is unpublished.
                    ygoyal578@gmail.com · 1 years ago
                    MS Excel 2016
                    • To post as a guest, your comment is unpublished.
                      skyyang · 1 years ago
                      The code works fine in my Excel 2016 as well, please try it with some smalll range data first.
                      • To post as a guest, your comment is unpublished.
                        ygoyal578@gmail.com · 1 years ago
                        Have tested on 160 records but in that still duplicate was there.
      • To post as a guest, your comment is unpublished.
        Anna · 3 years ago
        Thank you, it works perfectly, you saved me 2 days! :)
  • To post as a guest, your comment is unpublished.
    GDamasco85 · 3 years ago
    With the formula below:

    =IFERROR(INDEX($B$2:$B$45, MATCH(0, COUNTIF($D2:D2,$B$2:$B$45)+IF($A$2:$A$10<>$D2, 1, 0), 0)), 0)

    How can I transpose the data using approximate matches? Say, I want to extract all the values from Column B that match the first 9 characters / digits from Column A? Column B has 11 characters while A only 9. thank you!
  • To post as a guest, your comment is unpublished.
    Guest · 3 years ago
    i want to transpose duplicate values too (all values - unique + duplicate) and not just unique values. Can you give the formula for that too.
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 6 months ago
      I need the same
  • To post as a guest, your comment is unpublished.
    aidan5800 · 3 years ago
    Is there a way of doing this in reverse? I.e. data in rows of varying length and so sorting it into two columns? See attached.
  • To post as a guest, your comment is unpublished.
    mathewdidin@gmail.com · 3 years ago
    How to do the transpose if B column doesn't have unique values but still need those values
    KTE 100
    KTE 100
    Assuming that they are two different transaction
    • To post as a guest, your comment is unpublished.
      joyalisac25 · 6 months ago
      I too need the same. I want to display 100 twice is if there in the data

      • To post as a guest, your comment is unpublished.
        joyalisac25 · 6 months ago
        Can you suggest a formula for that

    • To post as a guest, your comment is unpublished.
      skyyang · 3 years ago
      Hi,Didin,

      Can you give your problem more clearly or detailed?
      You can insert an example screenshot for your problem.
      Thank you!
      • To post as a guest, your comment is unpublished.
        Bharath · 2 months ago
        Hi there,

        Could you please help me with below requirement.

        Product ----- order
        KTE           ------ 100
        KTE           ------ 200
        KTO           ------ 300
        KTO          ------   300

        expected output

        Product ----- order ----- order ------ order
        KTE      ------ 100  ------ 200
        KTO     ------ 300   ------ 300







  • To post as a guest, your comment is unpublished.
    Sanjeev Chidambaram · 3 years ago
    I just want to do the opposite. Like i have the end result already, and i want to achieve the first step.
    • To post as a guest, your comment is unpublished.
      Chris · 3 years ago
      I am looking for the same thing
      • To post as a guest, your comment is unpublished.
        Juan Carlos · 3 years ago
        Did you find any solution for the opposite scenario? Thanks!
        • To post as a guest, your comment is unpublished.
          Prial · 3 years ago
          I want to do the opposite as well. Any solution you got gents?
          • To post as a guest, your comment is unpublished.
            skyyang · 3 years ago
            Hello, guys,
            To get the opposite result based on the example of this article, you can apply the following VBA code: (Note:When selecting the data range that you want to transpose, please exclude the header row)

            Sub TransposeUnique_2()
            Dim xLRow, xLCount As Long
            Dim xRg As Range
            Dim xOutRg As Range
            Dim xObjRRg As Range
            Dim xTxt As String
            Dim xCount As Long
            Dim xVRg As Range
            On Error Resume Next
            xTxt = ActiveWindow.RangeSelection.Address
            Set xRg = Application.InputBox("please select data range:", "Kutools for Excel", xTxt, , , , , 8)
            Set xRg = Application.Intersect(xRg, xRg.Worksheet.UsedRange)
            If xRg Is Nothing Then Exit Sub
            If (xRg.Rows.count < 2) Or _
            (xRg.Areas.count > 1) Then
            MsgBox "Invalid selection", , "Kutools for Excel"
            Exit Sub
            End If
            Set xOutRg = Application.InputBox("please select output range(specify one cell):", "Kutools for Excel", xTxt, , , , , 8)
            If xOutRg Is Nothing Then Exit Sub
            Application.ScreenUpdating = False
            xLCount = xRg.Columns.count
            For xLRow = 1 To xRg.Rows.count
            Set xObjRRg = Range(xRg.Cells(xLRow, 2), xRg.Cells(xLRow, xLCount)).SpecialCells(xlCellTypeConstants)
            xObjRRg.Copy
            xOutRg.Offset(, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            Application.CutCopyMode = False
            Range(Cells(xOutRg.Row, xOutRg.Column), Cells(xOutRg.Row + xObjRRg.count - 1, xOutRg.Column)).Value = xRg.Cells(xLRow, 1).Value
            Set xOutRg = xOutRg.Offset(RowOffset:=xObjRRg.count)
            Next
            Application.ScreenUpdating = True
            End Sub
  • To post as a guest, your comment is unpublished.
    Pradeep · 4 years ago
    First step itself fails
    =INDEX($A$2:$A$16, MATCH(0, COUNTIF($D$1:$D1, $A$2:$A$16), 0)) gives Value Not Available error
  • To post as a guest, your comment is unpublished.
    Piyush · 4 years ago
    This was fantastic.
    I had an excel with around 2000 unique values in row A and couldn't have managed this exercise without your help.

    Many many thanks.
  • To post as a guest, your comment is unpublished.
    Tim · 4 years ago
    How would I go in the opposite direction? From multiple columns into a single column? Thanks in advance!

    Tim