Count all values of each row from smaller to larger

[Akuini]

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:

[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]

 

[lrobbo314]

Same idea, slightly different approach. Hopefully you don't have the same problems with scripting dictionaries as you do sortedlists.

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]

Sorry, forgot to delete this line:

Set vso = CreateObject("System.Collections.Sortedlist")

use this one instead:

[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]

Sorry, forgot to delete this line:

Set vso = CreateObject("System.Collections.Sortedlist")

use this one instead:

[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 </SPAN></SPAN>

I appreciate your help a lot for solving it multiple times

Have a good weekend</SPAN></SPAN>


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

 

[Akuini]

You're welcome, glad to help, & thanks for the feedback.

 

[lrobbo314]

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)

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

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]

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)

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

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 </SPAN></SPAN>