Macro to count occurances of decimal value

Excelnewbie001

Board Regular
Joined
Jan 25, 2017
Messages
79
6k5ug2cq
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
6k5ug2cq
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:

Excel Facts

Can Excel fill bagel flavors?
You can teach Excel a new custom list. Type the list in cells, File, Options, Advanced, Edit Custom Lists, Import, OK
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
 
Upvote 0
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
[TABLE="width: 142"]
<colgroup><col></colgroup><tbody>[TR]
[TD]3.66666666666667(1)[/TD]
[/TR]
[TR]
[TD]2.33333333333333(3)[/TD]
[/TR]
[TR]
[TD]1.66666666666667(1)[/TD]
[/TR]
[TR]
[TD]0.666666666666667(1)[/TD]
[/TR]
[TR]
[TD]0.333333333333333(1)[/TD]
[/TR]
</tbody>[/TABLE]


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
 
Upvote 0
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:
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,223,237
Messages
6,170,928
Members
452,366
Latest member
TePunaBloke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top