How can I count same colours using vba?

[agasi]

In column A, there are several different colours (red, green, yellow or white etc). I need to count each colours. In column B, I want to see total number (eg. If there are three rows in red, each row shows 3,3,3, if there two rows in yellow, each row in B shows 2,2 etc))

 

[mole999]

https://support.microsoft.com/en-gb/kb/2815384 that should work

 

[agasi]

I saw that one already but that is not what I am looking for. I need total numbers right next each row.

 

[MickG]

Try this:-
If results incorrect , please show Example an expected results.

[COLOR="Navy"]Sub[/COLOR] MG02Dec04
[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] K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("A1:A50")
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Interior.Color) [COLOR="Navy"]Then[/COLOR]
    .Add Dn.Interior.Color, Dn
[COLOR="Navy"]Else[/COLOR]
    [COLOR="Navy"]Set[/COLOR] .Item(Dn.Interior.Color) = Union(.Item(Dn.Interior.Color), Dn)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    .Item(K).Offset(, 1).Value = Mid(Application _
    .Rept("," & .Item(K).Count, .Item(K).Count), 2)
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[agasi]

Mick

Thanks a lot. Very close. But I don't want any number appears if it is white colour (Sorry I did not make myself clear in the original post). Colour code is to show they are duplications. It is like =COUNTIFS($A$5:$A$12,A5) in Excel.

Desricption	Count
Test in white
Test in white
Yellow	3
Red	2
Testx in white
Yellow	3
Red	2
Yellow	3

<tbody>
</tbody>

 

[MickG]

Try this:-

[COLOR="Navy"]Sub[/COLOR] MG02Dec13
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, K [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Range("A1:A50")
   [COLOR="Navy"]If[/COLOR] Not Dn.Interior.ColorIndex = xlNone [COLOR="Navy"]Then[/COLOR]
        [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Interior.Color) [COLOR="Navy"]Then[/COLOR]
            .Add Dn.Interior.Color, Dn
        [COLOR="Navy"]Else[/COLOR]
            [COLOR="Navy"]Set[/COLOR] .Item(Dn.Interior.Color) = Union(.Item(Dn.Interior.Color), Dn)
        [COLOR="Navy"]End[/COLOR] If
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] .keys
    .Item(K).Offset(, 1).Value = .Item(K).Count
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[agasi]

Mick

It works. That is what I just needed. Thank you so much. If possible, can you please explain the codes? I just have stepped through the code but I just don't have any idea as I am still very new to VBA.

 

[MickG]

You're welcome
The code requires an understanding of the Dictionary Object, see below for Guide:-
VBA for smarties: Dictionaries