Lookup and highlight matched cell with colours

[Mindee]

Hi Hi,
To someone that can safe me.

I need to do up a formulated worksheet.
Lets say Cell A1(Red colour cell)
and Cell A2(Blue colour cell)
and Cell A3(Green colour cell)
and Cell A4,B4,C4,D4,E4,F4,G4(Yellow colour cell)
and Cell A5,B5,C5,D5,E5,F5,G5(Orange colour cell)
These cells above will be key in with numbers.(numbers that i need t
find)

Column A to J row 8 to 500, will have thousands over numbers keyed i
earlier.(numbers to be lookup)

Now i need help in this, If those numbers to be lookup matches wit
those key in above, that cell should change colour accordingly. And os
able to give me an auto tabulate numbers of colour strike.
Lets say "1000Red,500Blue,450Green,890Yellow,300Orange)

Thank you for you help!
I really need this help.
Thank you a million, and may god bless this someone sweet and helpful.

minde

 

[Mindee]

Please would someone help

 

[Frank Kabel]

Hi
to be honest posting the same message over and over again won't help.
As I said please stay in the original thread and comment the solutions
provided. Multiple postings will result just in the opposite: Most
people will ignore your question

 

[Bob Phillips]

Hi Mindee,

Essentially you need VBA programming. Here is an example

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo ws_exit
If Not Interesct(Tragte,Range("A8:J500")) Is Nothing Then
With Target
If .Count = 1 Then
If .Column = 1 Then
Select Case .Value
Case Is = 1000
.Interior.ColorIndex = 3 'red
Case Is = 30
.Interior.ColorIndex = 46 'orange
Case Is = 890
.Interior.ColorIndex = 4 'green
Case Is = 4
.Interior.ColorIndex = 6 'yellow
Case Is = 5
.Interior.ColorIndex = 8 'majenta
Case Is = 450
.Interior.ColorIndex = 5 'blue
Case Is = 7
.Interior.ColorIndex = 15 'grey
Case Is = 8
.Interior.ColorIndex = 38 'rose
Case Is = 9
.Interior.ColorIndex = 1 'teal
Case Else 'none of the above numbers
Exit Sub
End Select
End If
End If
End With

ws_exit:
Application.EnableEvents = True

End Sub

This is worksheet code and goes in the worksheet coide module (right-click
on the sheet name tab, select the View Code menu option, and paste the code
in).

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Ken Wright]

Hi Mindee, you'll need code to format the cell colours as Conditional formatting
can only handle 3. An example of such code would be as follows, where the
1,2,3,4,5,6,7 etc in the Case 1, Case 2, Case3, Case 4, 5, 6 lines are the
values you have in your cells

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False

For Each oCell In Range("A8:J500")
Select Case oCell.Value
'Value from A1
Case 1
oCell.Interior.ColorIndex = 3
'Value from A2
Case 2
oCell.Interior.ColorIndex = 5
'Value from A3
Case 3
oCell.Interior.ColorIndex = 50
'Values from A4:G4
Case 4, 5, 6, 7, 8, 9, 10
oCell.Interior.ColorIndex = 6
'Values from A5:G5
Case 11, 12, 13, 14, 15, 16
oCell.Interior.ColorIndex = 40
'In case any of the values are wrong
Case Else
oCell.Interior.ColorIndex = 1
End Select
Next oCell

Application.EnableEvents = True
End Sub

To use this you have to right click on the tab of your sheet and select 'view
code' and then paste the above into it.

As far as adding up how many number are in each colour, then you are better off
using formulas for that, eg:-

In cells:-
I1 => =COUNTIF($A$8:$J$500,A1)
I2 => =COUNTIF($A$8:$J$500,A2)
I3 => =COUNTIF($A$8:$J$500,A3)
I4 => =SUMPRODUCT(COUNTIF($A$8:$J$500,$A$4:$G$4))
I5 => =SUMPRODUCT(COUNTIF($A$8:$J$500,$A$5:$G$5))
I6 => =COUNT(A8:J500)-SUM(I1:I5)

The last one is an error checker, and just like the code will turn any value
that doesn't appear in your list up top completely black, this will simply count
all the number in your range and then take away the sum of the counts above.
ANY delta means something is wrong.

 

[Ken Wright]

Oops - Should have handled any possible error as Bob did, else your events
become disabled, which might not mean much to you, but just accept it's not good
for what you want. Amended ( Pinching Bobs bit verbatim :-> )


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Application.ScreenUpdating = False
On Error GoTo ws_exit

For Each oCell In Range("A8:J500")
Select Case oCell.Value
Case 1
oCell.Interior.ColorIndex = 3
Case 2
oCell.Interior.ColorIndex = 5
Case 3
oCell.Interior.ColorIndex = 50
Case 4, 5, 6, 7, 8, 9, 10
oCell.Interior.ColorIndex = 6
Case 11, 12, 13, 14, 15, 16
oCell.Interior.ColorIndex = 40
Case Else
oCell.Interior.ColorIndex = 1
End Select
Next oCell

Application.ScreenUpdating = True
Application.EnableEvents = True

ws_exit:
Application.EnableEvents = True

End Sub

 

[Mindee]

Thank You Guys for that kind Help. It seems abit confusing to me as i
know nothing about VBA. Will figure it out and keep you guys posted!
Once Again thank you for your kind help and not ignoring me.

thank you
mindee

 

[Ken Wright]

know nothing about VBA.

Don't let that put you off Mindee, as you don't really need to know anything
about them. Many people use them every day without the faintest idea of how it
works, usually as a result of using the Macro recorder. The following link may
help you to get going with it though:-

http://www.mvps.org/dmcritchie/excel/getstarted.htm

And just keep posting back if you have questions, as we really won't bite, and
simply want to get you sorted

 

[Mindee]

Hi guys,

I have tried coping and paste those codes, but still cant work.
Instead Cell A8:J500 becomes black.
So sorry, but, did i miss out anything i am supposed to do.

Mindee

 

[Bob Phillips]

Mindee,

which code did you use in the end?

Did you put the code in the worksheet code module?

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Mindee]

HI Bob,
At first i was using ur code, however after copying it. there was a
"compile error".

So i tried Ken's Code and got A8:J500 black in colour. I tried two of
his code too. but still cant.

I just did what u told me, copy into the (tab right click and view
code.)

Mindee

 

[Bob Phillips]

Hi Mindee,

Ken's code does something odd, it changes all cells to black if not having a
value.

Here is an amended (an d tested) working cut of my code. Replace the current
code with this. I have picked up some of your values, you will need to
adjust the res.


Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
On Error GoTo ws_exit
If Not Intersect(Target, Range("A8:J500")) Is Nothing Then
With Target
If .Count = 1 Then
Select Case .Value
Case Is = 1000
.Interior.ColorIndex = 3 'red
Case Is = 30
.Interior.ColorIndex = 46 'orange
Case Is = 890
.Interior.ColorIndex = 4 'green
Case Is = 4
.Interior.ColorIndex = 6 'yellow
Case Is = 5
.Interior.ColorIndex = 8 'majenta
Case Is = 450
.Interior.ColorIndex = 5 'blue
Case Is = 7
.Interior.ColorIndex = 15 'grey
Case Is = 8
.Interior.ColorIndex = 38 'rose
Case Is = 9
.Interior.ColorIndex = 1 'teal
Case Else 'none of the above numbers
GoTo ws_exit
End Select
End If
End With
End If

ws_exit:
Application.EnableEvents = True
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Mindee]

Dear Bob,
Got It Those cells do change colour.
But what i need to acomplished here is:-
A8:J500 will have many numbers key in earlier.

I will then Key in one set of numbers into Cell A1, If it matches som
of those in A8:J500, the cell will change colour to red.

And Cell A2 if matches, those in A8:J500 will change to yellow.

And Cell A3 if matches will change to Blue

And Cell A4:J4 if matches will change to Green

And Cell A5:J5 if matches will change to blue.

I hope i explain myself correctly.
thank you bob.

mindee:-

 

[Bob Phillips]

Mindee,

If I understand, you want to mop up any previously entered values as well?
This is what Ken's code sought to do, with the proviso of those nasty black
cells.

Here's another try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

Application.EnableEvents = False
On Error GoTo ws_exit
If Not Intersect(Target, Range("A8:J500")) Is Nothing Then
For Each cell In Range("A8:J500")
With cell
Select Case .Value
Case Is = 1000
.Interior.ColorIndex = 3 'red
Case Is = 30
.Interior.ColorIndex = 46 'orange
Case Is = 890
.Interior.ColorIndex = 4 'green
Case Is = 4
.Interior.ColorIndex = 6 'yellow
Case Is = 5
.Interior.ColorIndex = 8 'majenta
Case Is = 450
.Interior.ColorIndex = 5 'blue
Case Is = 7
.Interior.ColorIndex = 15 'grey
Case Is = 8
.Interior.ColorIndex = 38 'rose
Case Is = 9
.Interior.ColorIndex = 1 'teal
Case Else 'none of the above numbers
End Select
End With
Next cell
End If

ws_exit:
Application.EnableEvents = True
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Mindee]

Hi bob,

Think there's a little miscommunication here, but i believe i am quit
close hee hee...

ok let me explain myself again.
I will need to use this worksheet everyday. And everyday numbers fro
A8:J500 will be different.

All i will need to do is, i will be given 23 sets of numbers. If an
cell from A8:J500 happen to contain those numbers, it should highligh
accordingly.

1st set of nos will be key in Cell A1(which is the red colour)

2nd set of nos will be key in Cell A2(which is the yellow colour)

3rd set of nos will be key in Cell A3(which is the blue colour)

10 sets of nos will be key in Cell A4:J4 (which is the green colour)

and the last 10 set of nos will be key in CellA5:J5 (grey colour)

Example:-
A1 is 0890
A2 is 2345
A3 is 4455
A4:J4 is 1221, 0079, 1234,5689,2345,5678,3456,8976,5769,0008
A5:J5 is 4545,7878,0090,2345,6577,3454,8899,4758,3454,5678

If 0890 appear in any cell in A8:J500, that cell should be red i
colour.

If 2345 did not apear in A8:J500, there wont be yellow highlighte
cell.

Same goes on..


Mindee :

 

[Ken Wright]

That was my error flag - Assumed all values had to be from the list being used,
so simply had any cells that didn't match the list turn black - Guess it would
have helped to clarify that though

--
Regards
Ken....................... Microsoft MVP - Excel
Sys Spec - Win XP Pro / XL 00/02/03

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission
----------------------------------------------------------------------------

Mindee,

If I understand, you want to mop up any previously entered values as well?
This is what Ken's code sought to do, with the proviso of those nasty black
cells.

Here's another try

Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range

Application.EnableEvents = False
On Error GoTo ws_exit
If Not Intersect(Target, Range("A8:J500")) Is Nothing Then
For Each cell In Range("A8:J500")
With cell
Select Case .Value
Case Is = 1000
.Interior.ColorIndex = 3 'red
Case Is = 30
.Interior.ColorIndex = 46 'orange
Case Is = 890
.Interior.ColorIndex = 4 'green
Case Is = 4
.Interior.ColorIndex = 6 'yellow
Case Is = 5
.Interior.ColorIndex = 8 'majenta
Case Is = 450
.Interior.ColorIndex = 5 'blue
Case Is = 7
.Interior.ColorIndex = 15 'grey
Case Is = 8
.Interior.ColorIndex = 38 'rose
Case Is = 9
.Interior.ColorIndex = 1 'teal
Case Else 'none of the above numbers
End Select
End With
Next cell
End If

ws_exit:
Application.EnableEvents = True
End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Mindee]

Hi Ken,

tried with ur code again. it doesn't work too
I cant see other colour other than A8:J500 in black, even though som
value matches.

Is this code very difficult to acommplish?


mindeemindee:

 

[Ken Wright]

Shouldn't be - Do you want to send me your workbook so I can see what's going
on. You just need to take the NOSPAM out of (e-mail address removed)

What version of Excel are you running with?

 

[Bob Phillips]

Hi Mindee,

Much clearer now <vbg>

I think you need a straight macro, not event code. Copy this code into a
normal code module, and then you will need to manually run it.

Sub ColourCells()
Dim cell As Range

For Each cell In Range("A8:J500")
With cell
If .Value <> "" Then
Select Case True
Case .Value = Range("A1").Value
.Interior.ColorIndex = 3 'red
Case .Value = Range("A2").Value
.Interior.ColorIndex = 6 'yellow
Case .Value = Range("A3").Value
.Interior.ColorIndex = 5 'blue
Case Evaluate("=NOT(ISERROR(MATCH(" & .Value &
",A4:J4,0)))")
.Interior.ColorIndex = 4 'yellowblue
Case Evaluate("=NOT(ISERROR(MATCH(" & .Value &
",A5:J5,0)))")
.Interior.ColorIndex = 16 'grey
Case Else 'none of the above numbers
.Interior.ColorIndex = xlColorIndexNone
End Select
Else
.Interior.ColorIndex = xlColorIndexNone
End If
End With
Next cell
End Sub

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

 

[Mindee]

Hi bob,
I copy and run it, but there is still a "compile error syntax error"
and Microsoft Visual Basic this commanmd will stop the debugger.

Hence i still cant try your new code.

Hi Ken,
I am currently using Excel for mac v.X. I just did what you told me to
howcome

Mindee: