Macro to count occurances of decimal value

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79
Looking for a macro that can count the occurrences of the decimal values in column O2-O20 and count and write them from highest to lowest in Q2-Q
20 .Any help much appreciated

https://files.fm/u/6k5ug2cq#/view/Count.jpg


P.S Your upload picture dont work on this website
 
Last edited:

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this:-
Code:
[COLOR="Navy"]Sub[/COLOR] MG16Feb40
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range("O2", Range("O" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Int(Dn.Value) = Dn.Value [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(CStr(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
             Dic.Add CStr(Dn.Value), 1
        [COLOR="Navy"]Else[/COLOR]
            Dic(CStr(Dn.Value)) = Dic(CStr(Dn.Value)) + 1
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, Lg [COLOR="Navy"]As[/COLOR] Double, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]

[COLOR="Navy"]With[/COLOR] Range("Q2").Resize(Dic.Count)
    .Value = Application.Transpose(Dic.keys())
    .Sort Range("Q2"), xlDescending
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("Q2").Resize(Dic.Count)
  [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
    [COLOR="Navy"]If[/COLOR] Val(K) = Dn.Value [COLOR="Navy"]Then[/COLOR]
        Dn.Value = Dn.Value & "(" & Dic(CStr(K)) & ")"
     [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]Next[/COLOR] Dn

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79
Hi Mick

Thank you very much for your macro. It works but is there any way the results can only be one decimal place.Currently it looks like this
3.66666666666667(1)
2.33333333333333(3)
1.66666666666667(1)
0.666666666666667(1)
0.333333333333333(1)

<colgroup><col></colgroup><tbody>
</tbody>


Can it look like this

3.7
2.3
1.7
0.7
0.3

The counting works perfectly -very well done Sir some great coding. Thanks for your help




Try this:-
Code:
[COLOR=Navy]Sub[/COLOR] MG16Feb40
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Q [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Set[/COLOR] Rng = Range("O2", Range("O" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Int(Dn.Value) = Dn.Value [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(CStr(Dn.Value)) [COLOR=Navy]Then[/COLOR]
             Dic.Add CStr(Dn.Value), 1
        [COLOR=Navy]Else[/COLOR]
            Dic(CStr(Dn.Value)) = Dic(CStr(Dn.Value)) + 1
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]
[COLOR=Navy]Dim[/COLOR] K [COLOR=Navy]As[/COLOR] Variant, Lg [COLOR=Navy]As[/COLOR] Double, c [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long[/COLOR]

[COLOR=Navy]With[/COLOR] Range("Q2").Resize(Dic.Count)
    .Value = Application.Transpose(Dic.keys())
    .Sort Range("Q2"), xlDescending
[COLOR=Navy]End[/COLOR] With

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Range("Q2").Resize(Dic.Count)
  [COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] K [COLOR=Navy]In[/COLOR] Dic.keys
    [COLOR=Navy]If[/COLOR] Val(K) = Dn.Value [COLOR=Navy]Then[/COLOR]
        Dn.Value = Dn.Value & "(" & Dic(CStr(K)) & ")"
     [COLOR=Navy]End[/COLOR] If
   [COLOR=Navy]Next[/COLOR] K
[COLOR=Navy]Next[/COLOR] Dn

[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
I Imagine its because your basic data has multiple decimal places and has been formatted down to 2 numbers.
Try changing the line as shown below in Red:-
Code:
Dn.Value =[COLOR="#FF0000"][B] Format(Dn.Value, "0.0") [/B][/COLOR]& "(" & Dic(CStr(K)) & ")"
 
Last edited:

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79

ADVERTISEMENT

I Imagine its because your basic data has multiple decimal places and has been formatted down to 2 numbers.
Try changing the line as shown below in Red:-
Code:
Dn.Value =[COLOR=#FF0000][B] Format(Dn.Value, "0.0") [/B][/COLOR]& "(" & Dic(CStr(K)) & ")"


Fabulous that sorted it out -Thank you for solving it -Great coding and Skills -Much respect you are truly a great MVP Thanks again

Excelnewbie001
 

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79

ADVERTISEMENT

You're welcome

MickG dont know if I must open a new question as it pertain to above macro -is it any ways possible to sort the counts from Highest to lowest in Column Q -if thats possible it will be great

Example

1.7(7)
4.0(4)
0.3(1)

So the highest counts at the top and the lowest at the bottom


If you can please advise if I should open a new question
Thanks again for your help

Excelnewbie
 

MickG

MrExcel MVP
Joined
Jan 9, 2008
Messages
14,841
Try this for results starting "Q2" .
NB:- The code uses column "R" as a helper column.
Code:
[COLOR="Navy"]Sub[/COLOR] MG18Feb10
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]Dim[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Set[/COLOR] Rng = Range("O2", Range("O" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Int(Dn.Value) = Dn.Value [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not Dic.Exists(CStr(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
             Dic.Add CStr(Dn.Value), 1
        [COLOR="Navy"]Else[/COLOR]
            Dic(CStr(Dn.Value)) = Dic(CStr(Dn.Value)) + 1
        [COLOR="Navy"]End[/COLOR] If
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]

[COLOR="Navy"]With[/COLOR] Range("q2").Resize(Dic.Count, 2)
    .Value = Application.Transpose(Array(Dic.keys, Dic.items))
    .Sort Range("R2"), xlDescending
[COLOR="Navy"]End[/COLOR] With

[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("q2").Resize(Dic.Count)
    Dn = Format(Dn.Value, "0.0") & "(" & Dn.Offset(, 1).Value & ")"
    Dn.Offset(, 1).Value = ""
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
Regards Mick
 

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79
Hi Mick

Thank you very much for the ammendmend it works great -Fantastic coding and thanks again for your help -MUCH appreciated


Try this for results starting "Q2" .
NB:- The code uses column "R" as a helper column.
Code:
[COLOR=Navy]Sub[/COLOR] MG18Feb10
[COLOR=Navy]Dim[/COLOR] Rng [COLOR=Navy]As[/COLOR] Range, Dn [COLOR=Navy]As[/COLOR] Range, n [COLOR=Navy]As[/COLOR] [COLOR=Navy]Long,[/COLOR] Q [COLOR=Navy]As[/COLOR] Variant
[COLOR=Navy]Dim[/COLOR] Dic [COLOR=Navy]As[/COLOR] Object
[COLOR=Navy]Set[/COLOR] Rng = Range("O2", Range("O" & Rows.Count).End(xlUp))
[COLOR=Navy]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Rng
    [COLOR=Navy]If[/COLOR] Not Int(Dn.Value) = Dn.Value [COLOR=Navy]Then[/COLOR]
        [COLOR=Navy]If[/COLOR] Not Dic.Exists(CStr(Dn.Value)) [COLOR=Navy]Then[/COLOR]
             Dic.Add CStr(Dn.Value), 1
        [COLOR=Navy]Else[/COLOR]
            Dic(CStr(Dn.Value)) = Dic(CStr(Dn.Value)) + 1
        [COLOR=Navy]End[/COLOR] If
    [COLOR=Navy]End[/COLOR] If
[COLOR=Navy]Next[/COLOR]

[COLOR=Navy]With[/COLOR] Range("q2").Resize(Dic.Count, 2)
    .Value = Application.Transpose(Array(Dic.keys, Dic.items))
    .Sort Range("R2"), xlDescending
[COLOR=Navy]End[/COLOR] With

[COLOR=Navy]For[/COLOR] [COLOR=Navy]Each[/COLOR] Dn [COLOR=Navy]In[/COLOR] Range("q2").Resize(Dic.Count)
    Dn = Format(Dn.Value, "0.0") & "(" & Dn.Offset(, 1).Value & ")"
    Dn.Offset(, 1).Value = ""
[COLOR=Navy]Next[/COLOR] Dn
[COLOR=Navy]End[/COLOR] [COLOR=Navy]Sub[/COLOR]
Regards Mick
 

Watch MrExcel Video

Forum statistics

Threads
1,108,501
Messages
5,523,293
Members
409,508
Latest member
Afc

This Week's Hot Topics

Top