using color background to signify same values

[zeekmcphee]

Hi folks,

In Column A1 to A10 each cell has a different number.However if two numbers are the same I want to colour the background a certain colour(lets say green).
If 3 numbers are the same the backcolour will be red and if 4 numbers are the same the number will be purple.
Is this possible with vba or any on board gizmos in excel???
Any suggestion much appreciated.
Regards
Zeek

 

[lrobbo314]

How about this?

Sub ColorDupes()
Dim cIndex: cIndex = Array(4, 3, 7)
Dim r As Range: Set r = Range("A1:A10")
Dim dCount As Integer: dCount = Evaluate(Replace("(CountA(@)-SUMPRODUCT(1/COUNTIF(@,@)))+1", "@", r.Address)) - 1
Dim cel As Range


For Each cel In r
    If Application.WorksheetFunction.CountIf(r, cel.Value) > 1 Then
        cel.Interior.ColorIndex = cIndex(dCount - 1)
    End If
Next cel


End Sub

 

[MickG]

Try this, cells change colour on change of value:-
Code to be pated in sheet Module
:- Right click sheet tab, select View code, Vbindow appears, paste code in Vbwindow

Private [COLOR=navy]Sub[/COLOR] Worksheet_Change(ByVal Target [COLOR=navy]As[/COLOR] Range)
[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, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Set[/COLOR] Rng = Range(Range("A1"), Range("A" & Rows.Count).End(xlUp))
Application.EnableEvents = False
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare

[COLOR=navy]If[/COLOR] Not Intersect(Target, Rng) [COLOR=navy]Is[/COLOR] Nothing [COLOR=navy]Then[/COLOR]
    Rng.Interior.ColorIndex = xlNone
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not .Exists(CStr(Dn.Value)) [COLOR=navy]Then[/COLOR]
        .Add CStr(Dn.Value), Dn
    [COLOR=navy]Else[/COLOR]
        [COLOR=navy]Set[/COLOR] .Item(CStr(Dn.Value)) = Union(.Item(CStr(Dn.Value)), Dn)
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
c = 2
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
    [COLOR=navy]If[/COLOR] .Item(K).Count > 1 [COLOR=navy]Then[/COLOR]
        c = c + 1
        .Item(K).Interior.ColorIndex = c
    [COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] If
[COLOR=navy]End[/COLOR] With
Application.EnableEvents = True
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[Fluff]

Using Conditional formatting
=COUNTIF(A1:A10,A1)=2 for green
=COUNTIF(A1:A10,A1)=3 for red
etc

 

[bygum]

wow!!! three answers and all work really well
many many thanks

 

[Fluff]

Glad we could help & thanks for the feedback