Count all values of each row from smaller to larger

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows

Thank you for your help I will continue searching if got it work will let you know
Moti
Let's try another way without using the sortedlist object:

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]
 

Some videos you may like

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,711
Office Version
365, 2019, 2016
Platform
Windows
Same idea, slightly different approach. Hopefully you don't have the same problems with scripting dictionaries as you do sortedlists.

Code:
Function StL(r As Range)
Dim AR() As Variant: AR = r.Value
Dim SD As Object: Set SD = CreateObject("Scripting.Dictionary")
Dim res As String
Dim tmp As Integer
Dim TA As Variant

For i = LBound(AR) To UBound(AR, 2)
    If Not SD.Exists(AR(1, i)) Then
        SD.Add AR(1, i), 1
    Else
        SD.Item(AR(1, i)) = SD.Item(AR(1, i)) + 1
    End If
Next i

TA = SD.keys

For i = 0 To UBound(TA)
    For j = i To UBound(TA)
        If TA(i) > TA(j) Then
            tmp = TA(i)
            TA(i) = TA(j)
            TA(j) = tmp
        End If
    Next j
Next

For k = 0 To UBound(TA)
    res = res & SD.Item(TA(k)) & "|"
Next k

StL = Left(res, Len(res) - 1)

End Function
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
Sorry, forgot to delete this line:
Code:
Set vso = CreateObject("System.Collections.Sortedlist")
use this one instead:
Code:
[FONT=lucida console][color=Royalblue]Sub[/color] a1082382c()
[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] 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]
 

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,782
Sorry, forgot to delete this line:
Code:
Set vso = CreateObject("System.Collections.Sortedlist")
use this one instead:
Code:
[FONT=lucida console][COLOR=royalblue]Sub[/COLOR] a1082382c()
[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] 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]
Outstanding! Akuini, much kind of you it worked like magic :biggrin:</SPAN></SPAN>

I appreciate your help a lot for solving it multiple times

Have a good weekend</SPAN></SPAN>
(y)

Kind Regards,
</SPAN></SPAN>
Moti
</SPAN></SPAN>
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,571
Office Version
365
Platform
Windows
You're welcome, glad to help, & thanks for the feedback.:)
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,711
Office Version
365, 2019, 2016
Platform
Windows
Just for kicks, especially keeping older versions of Excel in mind, here are 2 more options. The first is a purely array based UDF, and the second, which I might consider if I was stuck with Excel 2000, is a way to do this using Google Sheets instead of Excel. Unfortunately, passing ranges into custom functions is a bit of a mess in Sheets, so I will also show how you have to write the formula.

Excel (Only Array, no Scripting Dictionary or SortedList)
Code:
Function JA(r As Range) As String
Dim AR As Variant: AR = r.Value
Dim res As String: res = ""
Dim cnt As Long: cnt = 1
Dim tmp As Integer


For i = LBound(AR) To UBound(AR, 2)
    For j = i To UBound(AR, 2)
        If AR(1, i) > AR(1, j) Then
            tmp = AR(1, i)
            AR(1, i) = AR(1, j)
            AR(1, j) = tmp
        End If
    Next j
Next i


For k = LBound(AR) + 1 To UBound(AR, 2)
    If AR(1, k) = AR(1, k - 1) Then
        cnt = cnt + 1
    Else
        res = res & cnt & "|"
        cnt = 1
    End If
Next k


JA = res & cnt
End Function
Google Sheets
Code:
function COMBO(pRange) {
  var sheet = SpreadsheetApp.getActiveSpreadsheet().getActiveSheet();
  var arr = sheet.getRange(pRange).getValues();
  
  arr = transposeArray(arr);
  arr.sort();


  return getCounts(arr);
}


function transposeArray(array){
  var result = [];
  for (var col = 0; col < array[0].length; col++) { // Loop over array cols
    result[col] = [];
    for (var row = 0; row < array.length; row++) { // Loop over array rows
      result[col][row] = array[row][col]; // Rotate
    }
  }
  return result;
}


function getCounts(array) {
  var res = "";
  var cnt = 1;
  for (var i =1; i < array.length; i++) {
    Logger.log(i + ": " + array[i] + ", " + array[i-1]);
    if (array[i]+0 == array[i-1]+0) {
      cnt ++;
    } else {
      res = res + cnt + "|";
      cnt = 1;
    }
  }
  res+=cnt;
  return res;
}
And the formula to copy down, =COMBO(ADDRESS(ROW(A2),COLUMN(A2),4)&":"&ADDRESS(ROW(N2),COLUMN(N2),4)). Where A2 is the first cell in the row and N2 is the last cell in the row.
 

motilulla

Well-known Member
Joined
Feb 13, 2008
Messages
1,782
Just for kicks, especially keeping older versions of Excel in mind, here are 2 more options. The first is a purely array based UDF, and the second, which I might consider if I was stuck with Excel 2000, is a way to do this using Google Sheets instead of Excel. Unfortunately, passing ranges into custom functions is a bit of a mess in Sheets, so I will also show how you have to write the formula.

Excel (Only Array, no Scripting Dictionary or SortedList)
Code:
Function JA(r As Range) As String
Dim AR As Variant: AR = r.Value
Dim res As String: res = ""
Dim cnt As Long: cnt = 1
Dim tmp As Integer


For i = LBound(AR) To UBound(AR, 2)
    For j = i To UBound(AR, 2)
        If AR(1, i) > AR(1, j) Then
            tmp = AR(1, i)
            AR(1, i) = AR(1, j)
            AR(1, j) = tmp
        End If
    Next j
Next i


For k = LBound(AR) + 1 To UBound(AR, 2)
    If AR(1, k) = AR(1, k - 1) Then
        cnt = cnt + 1
    Else
        res = res & cnt & "|"
        cnt = 1
    End If
Next k


JA = res & cnt
End Function
Google Sheets
Code:
function COMBO(pRange) {
  var sheet = SpreadsheetApp.getActiveSpreadsheet().getActiveSheet();
  var arr = sheet.getRange(pRange).getValues();
  
  arr = transposeArray(arr);
  arr.sort();


  return getCounts(arr);
}


function transposeArray(array){
  var result = [];
  for (var col = 0; col < array[0].length; col++) { // Loop over array cols
    result[col] = [];
    for (var row = 0; row < array.length; row++) { // Loop over array rows
      result[col][row] = array[row][col]; // Rotate
    }
  }
  return result;
}


function getCounts(array) {
  var res = "";
  var cnt = 1;
  for (var i =1; i < array.length; i++) {
    Logger.log(i + ": " + array[i] + ", " + array[i-1]);
    if (array[i]+0 == array[i-1]+0) {
      cnt ++;
    } else {
      res = res + cnt + "|";
      cnt = 1;
    }
  }
  res+=cnt;
  return res;
}
And the formula to copy down, =COMBO(ADDRESS(ROW(A2),COLUMN(A2),4)&":"&ADDRESS(ROW(N2),COLUMN(N2),4)). Where A2 is the first cell in the row and N2 is the last cell in the row.
Hello lrobbo314, the "Function JA" results fine. I did not new it about "Google Sheets" every day there are new options thank you for letting me recognize.</SPAN></SPAN>

I do appreciate your help
</SPAN></SPAN>

Have a nice weekend
</SPAN></SPAN>

Kind Regards,
</SPAN></SPAN>
Moti :biggrin:
</SPAN></SPAN>
 

Watch MrExcel Video

Forum statistics

Threads
1,096,248
Messages
5,449,242
Members
405,560
Latest member
Jadax

This Week's Hot Topics

Top