Count and Display Occurrences of Unique values in a row

Question

I have pallets that can hold up to 4 items. Sometimes the same item is one pallet. To print a shipping label for this pallet I need to list the items on the pallet and the quantity of that item. I have found found a few formulas and scripts to count unique instances of columns, but not data kept in the same row. Here is how the data comes to me:

I need to get it into this format:

I have done the above manually to show what I need a formula or script to do. I have been trying to figure this out all day so any help is appreciated. Thank you!

Answer 1

Count and Rearrange

• Adjust the values in the constants section.

The Code

Option Explicit

Sub countRearrange()
    
    ' Define constants.
    Const srcName As String = "Sheet1"
    Const srcAddress As String = "G2:J4"
    Const dstName As String = "Sheet2"
    Const dstAddress As String = "S2:Z4"
    
    ' Define workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Write values from Source Range to Data Array.
    Dim Data As Variant: Data = wb.Worksheets(srcName).Range(srcAddress).Value
    Dim cCount As Long: cCount = UBound(Data, 2)
    
    ' Define Destination Range.
    Dim rg As Range: Set rg = wb.Worksheets(dstName).Range(dstAddress)
    
    ' Define Result Array.
    Dim Result As Variant
    ReDim Result(1 To rg.Rows.Count, 1 To rg.Columns.Count)
    
    ' Declare additional variables.
    Dim Key As Variant ' Current Data Array Value
    Dim i As Long ' Data Array Row Counter, Result Array Row Counter
    Dim j As Long ' Data Array Column Counter
    Dim n As Long ' Dictionary Element Counter, Result Array Column Counter
    Dim x As Long ' Result Array Column Counter
    
    ' Write values from Data Array to Result Array.
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(Data, 1)
            For j = 1 To cCount
                Key = Data(i, j)
                If Not IsError(Key) Then
                    If Len(Key) > 0 Then
                        If Not .Exists(Key) Then
                            n = n + 1
                            .Item(Key) = n
                            Result(i, 2 * n - 1) = Key
                            Result(i, 2 * n) = 1
                        Else
                            x = .Item(Key)
                            Result(i, 2 * x - 1) = Key
                            Result(i, 2 * x) = Result(i, 2 * x) + 1
                        End If
                    End If
                End If
            Next j
        Next i
    End With
        
    ' Write values from Result Array to Destination Range.
    rg.Value = Result
    
End Sub

Answer 2

You can also do this with Power Query , available in Excel 2010+

• Select a cell in the table
  • Data => Get & Transform => From Table/Range
• When the Power Query UI opens
  • Home => Advanced Editor and paste the M-Code into the window that opens
  • Change the Table name in Line 2 to reflect the real table name given your data
• Read the notes in the code, and examine the Applied Steps window to understand how it works

M Code

let
    Source = Excel.CurrentWorkbook(){[Name="Table11"]}[Content],

#"Changed Type" = Table.TransformColumnTypes(Source,{{"Item #1", type text}, {"Item #2", type text}, {"Item #3", type text}, {"Item #4", type text}}),
    #"Added Index" = Table.AddIndexColumn(#"Changed Type", "Index", 0, 1, Int64.Type),
    #"Grouped Rows" = Table.Group(#"Added Index", {"Index"}, {
        {"Grouped", each _, type table [#"Item #1"=nullable text, #"Item #2"=nullable text, #"Item #3"=nullable text, #"Item #4"=nullable text, Index=number]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "uniqueItemList", each 
        let 
            //Get list of relevant column Names for grouping of each subTable
            colNames = Table.ColumnNames(Source),
            tbl1 = Table.SelectColumns([Grouped],colNames),

            //Transpose the table
            transp = Table.Transpose(tbl1),

            //Get a count of each unique Item
            grp = Table.Group(transp,"Column1",{"count", each List.Count([Column1])}),

            //create Lists of the items and their count and "Zip" them together
            col1 = Table.Column(grp,"Column1"),
            count = Table.Column(grp,"count"),
            zip = List.Zip({col1,count}),

            //create the Label string
            label = List.Accumulate(zip,"", (state, current)=> 
                if state = ""
                    then current{0} & ";" & Text.From(current{1}) 
                    else 
                        if List.NonNullCount(current) = 2 
                            then state & ";" & current{0} & ";" & Text.From(current{1})
                            else state)
        in 
            label),

    //split the label string into separate columns
    #"Split Column by Delimiter" = Table.SplitColumn(#"Added Custom", "uniqueItemList", Splitter.SplitTextByDelimiter
        (";", QuoteStyle.Csv), {"Slot #1", "Slot #1 Qty", "Slot #2", "Slot #2 Qty", "Slot #3", "Slot #3 Qty","Slot #4", "Slot #4 Qty"}),

    //Delete unneeded columns    
    #"Removed Columns" = Table.RemoveColumns(#"Split Column by Delimiter",{"Index", "Grouped"}),
    #"Changed Type1" = Table.TransformColumnTypes(#"Removed Columns",{{"Slot #1", type text}, {"Slot #1 Qty", Int64.Type}, {"Slot #2", type text}, {"Slot #2 Qty", Int64.Type}, {"Slot #3", type text}, {"Slot #3 Qty", Int64.Type}, {"Slot #4", type text}, {"Slot #4 Qty", Int64.Type}})
in
    #"Changed Type1"

Answer 3

I think this is what you are looking for.

AA2 is =TRANSPOSE(UNIQUE(TRANSPOSE(FILTER(G2:J2,G2:J2<>"")))) . The TRANSPOSE is necessary because UNIQUE works vertically. The values in AB2:AD2 are spilled from AA2.

AE2 is =IF(AA2#="","",COUNTIF(G2:J2,AA2#)) . AF2:AH2 are spilled from AE2.

S2 is =IF(INDEX(AA2:AH2,{1,5,2,6,3,5,4,8})=0,"",INDEX(AA2:AH2,{1,5,2,6,3,7,4,8})) . T2:Z2 are spilled from S2.

Rows 3&4 are similar.