```
Sub a1082382a()
'https://www.mrexcel.com/forum/excel-questions/1082382-count-all-values-each-row-smaller-larger.htmlDim vso As Object
Dim va, vb
Dim i As Long, j As Long, k As Long, s As Long
Dim d As Object, vso As Object, x As Variant
va = Range("D7", Cells(Rows.count, "Q").End(xlUp))
ReDim vb(1 To UBound(va, 1), 1 To 1)
For j = 1 To UBound(va, 1)
Set vso = CreateObject("System.Collections.Sortedlist")
Set d = CreateObject("scripting.dictionary")
For k = 1 To UBound(va, 2)
s = va(j, k)
If Not d.Exists(s) Then
d(s) = 1
Else
d(s) = d(s) + 1
End If
Next
For Each x In d
vso.Add x, d.Item(x)
Next
For i = 0 To vso.count - 1
vb(j, 1) = vb(j, 1) & "|" & vso.GetByIndex(i)
Next
vb(j, 1) = Right(vb(j, 1), Len(vb(j, 1)) - 1)
Next
Range("S7").Resize(UBound(vb, 1), 1) = vb
End Sub
```