Akuini
Well-known Member
- Joined
- Feb 1, 2016
- Messages
- 2,266
- Office Version
- 2013
- Platform
- Windows
Let's try another way without using the sortedlist object:
Thank you for your help I will continue searching if got it work will let you know
Moti
Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1082382b()
[I][COLOR=seagreen]'https://www.mrexcel.com/forum/excel-questions/1082382-count-all-values-each-row-smaller-larger.html[/COLOR][/I]
[COLOR=Royalblue]Dim[/COLOR] va, vb
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], s [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] d [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Object[/COLOR]
va = Range([COLOR=brown]"D7"[/COLOR], Cells(Rows.count, [COLOR=brown]"Q"[/COLOR]).[COLOR=Royalblue]End[/COLOR](xlUp))
[COLOR=Royalblue]ReDim[/COLOR] vb([COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]For[/COLOR] j = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]Set[/COLOR] vso = CreateObject([COLOR=brown]"System.Collections.Sortedlist"[/COLOR])
[COLOR=Royalblue]Set[/COLOR] d = CreateObject([COLOR=brown]"scripting.dictionary"[/COLOR])
[COLOR=Royalblue]For[/COLOR] k = [COLOR=crimson]1[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(va, [COLOR=crimson]2[/COLOR])
s = va(j, k)
[COLOR=Royalblue]If[/COLOR] [COLOR=Royalblue]Not[/COLOR] d.Exists(s) [COLOR=Royalblue]Then[/COLOR]
d(s) = [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Else[/COLOR]
d(s) = d(s) + [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]If[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
arr = d.Keys
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]0[/COLOR] [COLOR=Royalblue]To[/COLOR] UBound(arr)
z = WorksheetFunction.Small(arr, i + [COLOR=crimson]1[/COLOR])
[I][COLOR=seagreen]' Debug.Print k, d(z)[/COLOR][/I]
vb(j, [COLOR=crimson]1[/COLOR]) = vb(j, [COLOR=crimson]1[/COLOR]) & [COLOR=brown]"|"[/COLOR] & d(z)
[COLOR=Royalblue]Next[/COLOR] i
vb(j, [COLOR=crimson]1[/COLOR]) = Right(vb(j, [COLOR=crimson]1[/COLOR]), Len(vb(j, [COLOR=crimson]1[/COLOR])) - [COLOR=crimson]1[/COLOR])
[COLOR=Royalblue]Next[/COLOR]
Range([COLOR=brown]"S7"[/COLOR]).Resize(UBound(vb, [COLOR=crimson]1[/COLOR]), [COLOR=crimson]1[/COLOR]) = vb
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]