Code Question

[FP Novice]

While searching the discussion group for a solution to overcome the
conditional formatting limit of 3, I found an entry by Gord Dibben. It is a
source code entry that I was hoping would change the color of the text to the
given value when my VLOOKUP returned certain results.

Specifically I am entering a number and VLOOKUP returns one of twelve
colors, I want the color of the text to match the word that was retrieved.

It does not work as entered in VB as follows:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Dim vRngInput As Range
Set vRngInput = Intersect(Target, Range("H6"))
If vRngInput Is Nothing Then Exit Sub
On Error GoTo endit
Application.EnableEvents = False
For Each rng In vRngInput
'Determine the color
Select Case UCase(rng.Value)
Case Is = "BLUE": Num = 5 'blue
Case Is = "ORANGE": Num = 45 'orange
Case Is = "GREEN": Num = 10 'green
Case Is = "BROWN": Num = 53 'brown
Case Is = "SLATE": Num = 15 'slate
Case Is = "WHITE": Num = 1 'black
Case Is = "RED": Num = 3 'red
Case Is = "BLACK": Num = 1 'black
Case Is = "YELLOW": Num = 6 'yellow
Case Is = "VIOLET": Num = 54 'violet
Case Is = "ROSE": Num = 38 'rose
Case Is = "AQUA": Num = 42 'aqua
End Select
'Apply the color
rng.Interior.ColorIndex = Num
Next rng
endit:
Application.EnableEvents = True
End Sub

 

[FSt1]

hi
what is it not doing?

Regards
FSt1

 

[FP Novice]

It does not change the color of the text, the color of the text remains the
same after every lookup.

 

[FP Novice]

I think I know why it does not work, I do not know how to make it work... In
cell H6 (where the results are supplied) the cell contents remain a VLOOKUP
formula even though I 'see' "BLUE" "ORANGE" etc... the cell is still a
formula thus VBA does not see a qualifier and therefore will not change the
color of the text... Does this make sense? If so how do I make it work?

 

[Gord Dibben]

Try this revision. Note the Calculate event.


Private Sub Worksheet_Calculate()
Dim Num As Long
Dim rng As Range
Dim vRngInput As Range
Set vRngInput = Me.Range("H6") 'or H1:H20
If vRngInput Is Nothing Then Exit Sub
On Error GoTo endit
Application.EnableEvents = False
For Each rng In vRngInput
'Determine the color
Select Case UCase(rng.Offset(0, 1).Value)
Case Is = "BLUE": Num = 5 'blue
Case Is = "ORANGE": Num = 45 'orange
Case Is = "GREEN": Num = 10 'green
Case Is = "BROWN": Num = 53 'brown
Case Is = "SLATE": Num = 15 'slate
Case Is = "WHITE": Num = 1 'black
Case Is = "RED": Num = 3 'red
Case Is = "BLACK": Num = 1 'black
Case Is = "YELLOW": Num = 6 'yellow
Case Is = "VIOLET": Num = 54 'violet
Case Is = "ROSE": Num = 38 'rose
Case Is = "AQUA": Num = 42 'aqua
End Select
'Apply the color
rng.Offset(0, 1).Interior.ColorIndex = Num
Next rng
endit:
Application.EnableEvents = True
End Sub


Gord

 

[Gord Dibben]

Please ignore this.

I mis-read and screwed up per usual.

Get back to you later.


Gord

 

[Gord Dibben]

Maybe this one?

Private Sub Worksheet_Calculate()
Dim Num As Long
Dim rng As Range
Set rng = Me.Range("H6")
On Error GoTo endit
Application.EnableEvents = False
'Determine the color
Select Case UCase(rng.Value)
Case Is = "BLUE": Num = 5 'blue
Case Is = "ORANGE": Num = 45 'orange
Case Is = "GREEN": Num = 10 'green
Case Is = "BROWN": Num = 53 'brown
Case Is = "SLATE": Num = 15 'slate
Case Is = "WHITE": Num = 1 'black
Case Is = "RED": Num = 3 'red
Case Is = "BLACK": Num = 1 'black
Case Is = "YELLOW": Num = 6 'yellow
Case Is = "VIOLET": Num = 54 'violet
Case Is = "ROSE": Num = 38 'rose
Case Is = "AQUA": Num = 42 'aqua
End Select
'Apply the color
rng.Interior.ColorIndex = Num
endit:
Application.EnableEvents = True
End Sub


Gord

 

[FP Novice]

Still nothing Gord, If you like I can send the file to you so that you can
take a look, my quess is the VLOOKUP is keeping the macro from 'seeing' the
text in H6...

 

[Dave Peterson]

It worked for me -- as long as I had a formula in H6 that evaluated to one of
those strings--blue, Orange, ...

Do you have calculation set to automatic?

And you have a formula in H6 that will evaluate to one of those strings--no
trailing spaces, no extra characters, right???

 

[Don Guillett]

I also successfully tested Gord's code where h6 contained
=VLookup(g6,table,2,0). Maybe you need to add the ,0 at the end?

 

[FP Novice]

Thanks Dave,

I did get it to work, I had to delete my formula and re-enter it and voila
it worked. The only problem that I have now is that I have two cells H6 and
J6 that will return colors at the same time (fiber optic binder color & fiber
strand color) do I simply change the me.range from ("H6") to ("H^:J6")? or is
it a different entry than me.range?

Also it is changing the cell color and not the text (font) color which is
what I would like to have...

Thanks to the both of you for some great assistance..

 

[FP Novice]

Here is what I am using for one of two lookups (this one is in H6)

=IF(ISERROR(VLOOKUP(I6,List!$A$2:$C$14989,3,FALSE)),"",VLOOKUP(I6,List!$A$2:$C$14989,3,FALSE))

Column two is simply a color name: "BLUE", "ORANGE", "GREEN" (fiber optic
color code...

 

[FP Novice]

Here is what I am using for one of two lookups (this one is in H6)

=IF(ISERROR(VLOOKUP(I6,List!$A$2:$C$14989,3,FALSE)),"",VLOOKUP(I6,List!$A$2:$C$14989,3,FALSE))

Column THREE is simply a color name: "BLUE", "ORANGE", "GREEN" (fiber optic
color code...

 

[Dave Peterson]

If you want just H6 and J6:
Set rng = Me.Range("H6,J6")

If you want H6:J6 (including I6):
Set rng = Me.Range("H6:i6")

 

[FP Novice]

Thanks for all of your help, it has stopped working for some reason and I
cannot get it back. As such I am beginning to think it is to much of a hassle
and not worth the effort, it is simply for aesthetics anyhow. I certainly
appreciate the brilliance behind your assistance.

Thanks

 

[FP Novice]

At the risk of driving you all crazy, I got it to work using Gord's suggested
string. The reason that it would not work was due to protecting the sheet,
once protection was removed I was fine.

New trouble is this:

Dim rng As Range
Set rng = Me.Range("H6,J6")
On Error GoTo endit

Since I am looking for two different results upon every lookup, H6 (color1),
and J6 (color2) I need two cells to change different colors. As it stands now
both cells change to the same color. If I lead the range with H6 they both
change to the color of the returned value in H6, if I lead the range with J6
both cells change to the color of the returned value in J6. I need them to
change respective to their own returned results.

 

[FP Novice]

I have it working as desired...


Private Sub Worksheet_Calculate()
Dim Num As Long
Dim rng As Range
Set rng = Me.Range("H6")
On Error GoTo endit
Application.EnableEvents = False
'Determine the color
Select Case UCase(rng.Value)
Case Is = "BLUE": Num = 5 'blue
Case Is = "ORANGE": Num = 45 'orange
Case Is = "GREEN": Num = 10 'green
Case Is = "BROWN": Num = 53 'brown
Case Is = "SLATE": Num = 15 'slate
Case Is = "WHITE": Num = 1 'black
Case Is = "RED": Num = 3 'red
Case Is = "BLACK": Num = 1 'black
Case Is = "YELLOW": Num = 6 'yellow
Case Is = "VIOLET": Num = 54 'violet
Case Is = "ROSE": Num = 38 'rose
Case Is = "AQUA": Num = 42 'aqua
End Select
'Apply the color
rng.Font.ColorIndex = Num
endit:
Application.EnableEvents = True
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Num As Long
Dim rng As Range
Set rng = Me.Range("J6")
On Error GoTo endit
Application.EnableEvents = False
'Determine the color
Select Case UCase(rng.Value)
Case Is = "BLUE": Num = 5 'blue
Case Is = "ORANGE": Num = 45 'orange
Case Is = "GREEN": Num = 10 'green
Case Is = "BROWN": Num = 53 'brown
Case Is = "SLATE": Num = 15 'slate
Case Is = "WHITE": Num = 1 'black
Case Is = "RED": Num = 3 'red
Case Is = "BLACK": Num = 1 'black
Case Is = "YELLOW": Num = 6 'yellow
Case Is = "VIOLET": Num = 54 'violet
Case Is = "ROSE": Num = 38 'rose
Case Is = "AQUA": Num = 42 'aqua
End Select
'Apply the color
rng.Font.ColorIndex = Num
endit:
Application.EnableEvents = True
End Sub

Thanks for your help!!!