Transpose Unique Values in column to row

[D3allamerican07]

Column A on Sheet1 has many different remarks. I need to make a unique list on Sheet2 with values from Column A on Sheet1 but post it in one row. This is the idea:

Sheet1:
Column A
1
1
2
2
2
3
3
3

Sheet2:
Column A------------Column B------------Column C
1-------------------------2----------------------3

The code I have doesn't quite work:

Sheets("Sheet1").Range("A:A").AdvancedFilter Action:=xlFilterInPlace, Unique:=True
    Selection.Copy
    Range("B1").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

 

[DanteAmor]

Thanks DanteAmor.
But code is not getting executed properly. It is taking some values of column A value to column D also. and it is not considering all the data from A2:C.

You need to check your data, maybe you have strange characters between the cells, blank spaces after the words, combined cells. They are just assumptions, all macros are working with sample data, but all macros are failing with your data.

Another attempt, this one ensures reading only A:C data:

Sub TransposeColumns()
  Dim a As Variant, b() As Variant
  Dim dic As Object, i As Long, lin As Long, col As Long, n As Long
  Dim lr As Long
  
  lr = ActiveSheet.Range("A:C").Find("*", , xlValues, , xlByRows, xlPrevious).Row
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2:C" & lr).Value2
  Range("D2", Cells(Rows.Count, Columns.Count)).ClearContents
  
  For i = 1 To UBound(a)
    dic(a(i, 1)) = dic(a(i, 1)) + 1
    If dic(a(i, 1)) > n Then n = dic(a(i, 1))
  Next
  n = (n * 2) + 1
  ReDim b(1 To dic.Count, 1 To n)
  dic.RemoveAll
  For i = 1 To UBound(a)
    If Not dic.exists(a(i, 1)) Then
      lin = lin + 1
      col = 1
      b(lin, col) = a(i, 1)
    Else
      lin = Split(dic(a(i, 1)), "|")(0)
      col = Split(dic(a(i, 1)), "|")(1) + 2
    End If
    dic(a(i, 1)) = lin & "|" & col
    b(lin, col + 1) = a(i, 2)
    b(lin, col + 2) = a(i, 3)
  Next
  Application.ScreenUpdating = False
  Range("E2").Resize(dic.Count, n).Value = b
  Application.ScreenUpdating = True
End Sub

 

[ygoyal578]

Hi Peter_SSs
My bad. I was not aware of that. Thanks for letting me know.

@ygoyal578
Is there not a leading or trailing space involved?

Hi Jolivanes: Data is stating from A4 cell and there after no space are there.

 

[ygoyal578]

Thanks bro the code is working fine. But getting 1 duplicate in between the newly transposed data.

Thanks bro the code is working fine. But getting 1 duplicate in between the newly transposed data.

Hi Bro, The code is working fine but in case there is only 1 type of value in column B then it is showing error. Attaching same for your reference.