Formula or VBA to Calculate Digit Occurence

[ststern45]

Hello everyone,

I wanted to ask if a formula or vba code could calculate the following:

1>I have a random set of digits 0 through 9 in cell range F3:F23. The digits in the cell range are in the order/sequence. So cell F3 is 1st, F4 = 2nd, etc.

F3 = 2
F4 = 5
F5 = 0
F6 = 5
F7 = 0
F8 = 6
F9 = 4
F10 = 7
F11 = 8
F12 = 4
F13 = 9
F14 = 1
F15 = 0
F16 = 0
F17 = 0
F18 = 5
F19 = 1
F20 = 0
F21 = 8
F22 = 8
F23 = 7

Digit 0 = 6 Times
Digit 1 = 2
Digit 2 = 1
Digit 3 = 0
Digit 4 = 2
Digit 5 = 3
Digit 6 = 1
Digit 7 = 2
Digit 8 = 3
Digit 9 = 1

I would like to arrange the digits as follows:

Digit(s) with the highest total at the top, and then going downward by appearance in the cell range from F3:F23.

For example, the final result would look like the following:

0 = 6 times
5 = 3
8 = 3
4 = 2
7 = 2
1 = 2
2 = 1
6 = 1
9 = 1
3 = 0 times

Here is the question. Notice the digits 5 and 8 appeared 3 times each. The 5 needs to go below the digit 0 since this was the next digit in the string from F3:F23 followed by the 8.

The digits 4, 7, and 1 appeared 2 times each. The 4 appeared 1st then the 7, then the 1 in the string from F3:F23

The digits 2, 6, and 9 appeared 1 time each. The 2 appeared 1st then the 6, then the 9 in the string from F3:F23.

Thank you in advance!!

 

[Fluff]

How about

Sub ststern45()
   Dim Cl As Range
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("F3", Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = .Item(Cl.Value) + 1
      Next Cl
      Range("G3").Resize(.Count).Value = Application.Transpose(.Keys)
      Range("H3").Resize(.Count).Value = Application.Transpose(.Items)
   End With
   Range("G3", Range("G" & Rows.Count).End(xlUp).Offset(, 1)).Sort Key1:=Range("H3"), Order1:=xlDescending, Header:=xlNo
End Sub

 

[ststern45]

Thanks Fluff.

Everything works great except for the last value 3 = 0

Running the code gives me the following:

Cell Column G3:G11

0
5
8
4
7
1
2
6
9
3 Missing

Cell column H3:H23
6
3
3
2
2
2
1
1
0 Missing

Thanks

 

[Fluff]

How about

Sub ststern45()
   Dim Cl As Range
   Dim i As Long
   
   With CreateObject("scripting.dictionary")
      For Each Cl In Range("F3", Range("F" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = .Item(Cl.Value) + 1
      Next Cl
      Range("G3").Resize(.Count).Value = Application.Transpose(.Keys)
      Range("H3").Resize(.Count).Value = Application.Transpose(.Items)
      For i = 0 To 9
         If Not UBound(Filter(.Keys, i, True)) >= 0 Then
            With Range("G" & Rows.Count).End(xlUp)
               .Offset(1).Value = i
               .Offset(1, 1).Value = 0
            End With
         End If
      Next i
   End With
   Range("G3", Range("G" & Rows.Count).End(xlUp).Offset(, 1)).Sort Key1:=Range("H3"), Order1:=xlDescending, Header:=xlNo
End Sub

 

[ststern45]

Fluff,

Excellent work!!

Thank you sooooo much.

 

[Fluff]

You're welcome & thanks for the feedback

 

[ststern45]

Macro is excellent.

Have a request if possible.

When 2 digit have a value = 0 such as the digits 7 & 9 below. Is it possible to reverse the digits whereas the higher digit 9 is before the digit 7?

So instead of:
G3 = 4
G4 = 3
G5 = 1
G6 = 6
G7 = 2
G8 = 5
G9 = 8
G10 = 7
G11 = 9

Be this:

G3 = 4
G4 = 3
G5 = 1
G6 = 6
G7 = 2
G8 = 5
G9 = 8
G10 = 9
G11 = 7



F3 = 6
F4 = 3
F5 = 2
F6 = 4
F7 = 6
F8 = 5
F9 = 4
F10 = 8
F11 = 0
F12 = 4
F13 = 1
F14 = 5
F15 = 4
F16 = 2
F17 = 4
F18 = 0
F19 = 8
F20 = 3
F21 = 1
F22 = 3
F23 = 1


G3 = 4
G4 = 3
G5 = 1
G6 = 6
G7 = 2
G8 = 5
G9 = 8
G10 = 7
G11 = 9


H3 = 5
H4 = 3
H5 = 3
H6 = 2
H7 = 2
H8 = 2
H9 = 2
H10 = 2
H11 = 0
H12 = 0


Thank you!!

 

[Fluff]

Make this change

      For i = 9 To 3

 

[ststern45]

Thank you again!!

 

[Fluff]

You're welcome