Is this such a difficult problem for Excel connoisseurs?
Posted by Vera on October 24, 2001 8:29 AM
In column A1:A8 I have empty cells or numbers; I need to get flagged (fill the cell with different colors for every different set of similar numbers ) whenever the number in a cell is not unique among the range A1:A8. As I know the conditional formatting is limited to 3 conditions but I will be satisfied even with limit (in my case sometimes I would need more than 3 conditions). Ok here is my example
A1 3 fill cell in green
A2 5555 no filling
A3 3 fill cell in green
A4 77 fill cell in red
A5 3 fill cell in green
A6 222 fill cell in blue
A7 77 fill cell in red
A8 222 fill cell in blue
I hope that is clear enough; thank you so much in advance
Posted by RBG on October 24, 2001 8:44 AM
No, it is not clear enough. Which is probably why no-one responded before.
When you say "similar numbers", do you mean same numbers?
Are the only possible numbers the ones you posted or can the numbers be anything?
Does each cell contain only digits of the same value, as in your examples? Or can there be "mixed" numbers like 323?
Posted by Vera on October 25, 2001 5:06 AM
Similar numbers=duplicates, same numbers
It can be any number
They can be mixed (it just happened that in my example I used 77 or 222, it was faster to type I guess).
thank you for your help
Posted by RGB on October 25, 2001 8:29 AM
It can be any number They can be mixed (it just happened that in my example I used 77 or 222, it was faster to type I guess). thank you for your help
There's probably a better way of doing this, but try the following macro :-
Sub Color_Matching_Numbers()
Dim theRange As Range
Dim cell As Range, rng As Range, x As Integer
x = 3
Application.ScreenUpdating = False
Columns(1).Insert
Set theRange = Range("A1:A8")
With theRange
.Cells(1, 1).Value = 1
.DataSeries
.EntireRow.Sort Key1:=.Cells(1, 2)
End With
For Each cell In theRange.Offset(0, 1)
If cell = cell.Offset(1, 0) Then
If rng Is Nothing Then
Set rng = Union(cell, cell.Offset(1, 0))
Else
Set rng = Union(rng, cell.Offset(1, 0))
End If
Else
If rng Is Nothing Then
cell.Interior.ColorIndex = xlNone
Else
rng.Interior.ColorIndex = x
Set rng = Nothing
If x = 3 Then
x = 4
Else
x = 5
End If
End If
End If
Next
With theRange
.EntireRow.Sort Key1:=.Cells(1, 1)
.EntireColumn.Delete
End With
End Sub
If you want the colors automatically updated whenever new data is input to any cell in A1:A8, then put this in the Sheet's code module :-
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A8")) Is Nothing Then
Application.EnableEvents = False
Color_Matching_Numbers
Application.EnableEvents = True
End If
End Sub
