CODEWITHSUNDEEP
excelvbapivotpowerquery
NidenK
NidenK

Reputation: 369

How to pivot duplicate rows to columns?

having a hard time figuring out how to pivot a multi-column data set with duplicate rows into unique columns.

This is what I'm trying to achieve

I have done research and found some VBA scripts to do this, but it is resulting in data missing when I do counts to confirm it pivoted correctly and ends up adding in duplicate columns (name/ rating year) over and over.

Anyone have any ideas? I'd do a pivot table, but I can't display the actual rating values in a pivot, only a sum/count/avg. etc...

Upvotes: 0

Views: 735

Answers (2)

VBasic2008
VBasic2008

Reputation: 54807

Pivot Data

The Code

Option Explicit

Sub pivotData()
    
    ' Define Source Range.
    Dim rng As Range
    Set rng = Range("A1").CurrentRegion
    
    ' Get unique values.
    Dim prs As Variant
    prs = getUniqueColumn1D(rng.Columns(1).Resize(rng.Rows.Count - 1).Offset(1))
    Dim yrs As Variant
    yrs = getUniqueColumn1D(rng.Columns(2).Resize(rng.Rows.Count - 1).Offset(1))
    sort1D yrs
    
    ' Source Range to Source Array.
    Dim Source As Variant
    Source = rng.Value
    
    ' Define Target Array.
    Dim Target As Variant
    ReDim Target(1 To UBound(prs) - LBound(prs) + 2, _
                 1 To UBound(yrs) - LBound(yrs) + 2)
    
    ' Write from arrays to Target Array.
    Target(1, 1) = Source(1, 1)
    Dim n As Long
    Dim i As Long
    i = 1
    For n = LBound(prs) To UBound(prs)
        i = i + 1
        Target(i, 1) = prs(n)
    Next n
    Dim j As Long
    j = 1
    For n = LBound(yrs) To UBound(yrs)
        j = j + 1
        Target(1, j) = yrs(n)
    Next n
    For n = 2 To UBound(Source, 1)
        i = Application.Match(Source(n, 1), prs, 0) + 1
        j = Application.Match(Source(n, 2), yrs, 0) + 1
        Target(i, j) = Source(n, 3)
    Next n
            
    ' Define Target Range.
    Set rng = Range("E1").Resize(UBound(Target, 1), UBound(Target, 2))
    
    ' Write from Target Array to Target Range.
    rng.Value = Target
            
    ' Inform user.
    MsgBox "Data transferred.", vbInformation, "Success"
    
End Sub

' Returns the unique values from a column range.
Function getUniqueColumn1D(ColumnRange As Range, _
                           Optional ByVal Sorted As Boolean = False) _
         As Variant
    Dim Data As Variant
    Data = ColumnRange.Columns(1).Value
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        Dim Key As Variant
        Dim i As Long
        For i = 1 To UBound(Data, 1)
            Key = Data(i, 1)
            If Not IsError(Key) And Not IsEmpty(Key) Then
                .Item(Key) = Empty
            End If
        Next i
        If .Count > 0 Then
            getUniqueColumn1D = .Keys
        End If
    End With
End Function

' Sorts a 1D array only if it contains values of the same data type.
Sub sort1D(ByRef OneD As Variant, _
           Optional ByVal Descending As Boolean = False)
    With CreateObject("System.Collections.ArrayList")
        Dim i As Long
        For i = LBound(OneD) To UBound(OneD)
            .Add OneD(i)
        Next i
        .Sort
        If Descending Then
            .Reverse
        End If
        OneD = .ToArray
    End With
End Sub

Upvotes: 1

Hooded 0ne
Hooded 0ne

Reputation: 997

You can do this easily in powerquery.

  1. Highlight all your data, then insert>add table
  2. data tab>get data from table
  3. highlight right two columns>pivot columns
  4. rating level as values
  5. advanced options>don't aggregate
  6. find and replace null with nothing
  7. save and close

Upvotes: 1

Related Questions