Macro to count occurances of decimal value

E

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

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
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




MickG said:
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
Click to expand...
 
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
MickG said:
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)) & ")"
Click to expand...


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
MickG said:
You're welcome
Click to expand...

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


MickG said:
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
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

N
  • Question Question
Auto Sort for Leaderboard
Replies
0
Views
601
NTLKnight
N
J
  • Solved
trending value projections without counting sundays
Replies
2
Views
298
KRice
K
G
  • Question Question
Excel VBA - Counting Negative Values and Ranking Them
Replies
1
Views
469
kweaver
kweaver
B
  • Question Question
Macro that concatenates two cells, references a Date and then copy pastes value into first available row
Replies
0
Views
594
banneduser123
B
MrDB4Excel
  • Question Question
If Find Blank Cell
Replies
0
Views
710
MrDB4Excel
MrDB4Excel

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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