Continued Post - If statement and colors
 

Thanks Shane and Bob, the code works fine except it does not follow what the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

incidentally O5 through O43 are merged cells, O5 and O6, O7 and O8 etc. I
also find that once the first cell reacts, I change the value and nothing
happens.
"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

Could this be the possible problem why the cells are not reacting. Each cell
is populated using a Vlookup code, this code is in cell O5 and is nearly
duplicated in O7 except for the lookup value location which is $B23. This
continues to each merged cell to O43

=VLOOKUP($B22,$B$75:$C$346,2,FALSE)

"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

The cell color only reacts if the number is manually entered and the enter
key is pressed. This results in the formula being deleted also.

"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

Here is my latest attempt in solving this issue. The code is at the end of a
very large macro

' The next line is the declaration at the start of the macro
Const WS_RANGE = "O5:O43"

' Code at the end of Macro ( Please remember I have 12 sheets, R1 thru R12
that this has to work on.)

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Interior

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 3
Case 2
Range(WS_RANGE).ColorIndex = 2
Case 3
Range(WS_RANGE).ColorIndex = 41
Case 4
Range(WS_RANGE).ColorIndex = 6
Case 5
Range(WS_RANGE).ColorIndex = 50
Case 6
Range(WS_RANGE).ColorIndex = 1
Case 7
Range(WS_RANGE).ColorIndex = 46
Case 8
Range(WS_RANGE).ColorIndex = 7
Case 9
Range(WS_RANGE).ColorIndex = 42
Case 10
Range(WS_RANGE).ColorIndex = 13
Case 11
Range(WS_RANGE).ColorIndex = 48
Case 12
Range(WS_RANGE).ColorIndex = 4
End Select

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Font

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 2
Case 2
Range(WS_RANGE).ColorIndex = 1
Case 3
Range(WS_RANGE).ColorIndex = 2
Case 4
Range(WS_RANGE).ColorIndex = 1
Case 5
Range(WS_RANGE).ColorIndex = 6
Case 6
Range(WS_RANGE).ColorIndex = 6
Case 7
Range(WS_RANGE).ColorIndex = 1
Case 8
Range(WS_RANGE).ColorIndex = 1
Case 9
Range(WS_RANGE).ColorIndex = 1
Case 10
Range(WS_RANGE).ColorIndex = 2
Case 11
Range(WS_RANGE).ColorIndex = 3
Case 12
Range(WS_RANGE).ColorIndex = 1
End Select


Application.ScreenUpdating = True
Application.Cursor = xlDefault
On Error GoTo 0
End Sub




"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

Sorry but it is impossible to keep up with you, you are moving the goalposts
continually. First it was event code, then merged cells, then it is at the
end of a large macro.

You have lost me.

--
__________________________________
HTH

Bob

"Shu of AZ" wrote in message
...
Here is my latest attempt in solving this issue. The code is at the end
of a
very large macro

' The next line is the declaration at the start of the macro
Const WS_RANGE = "O5:O43"

' Code at the end of Macro ( Please remember I have 12 sheets, R1 thru
R12
that this has to work on.)

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Interior

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 3
Case 2
Range(WS_RANGE).ColorIndex = 2
Case 3
Range(WS_RANGE).ColorIndex = 41
Case 4
Range(WS_RANGE).ColorIndex = 6
Case 5
Range(WS_RANGE).ColorIndex = 50
Case 6
Range(WS_RANGE).ColorIndex = 1
Case 7
Range(WS_RANGE).ColorIndex = 46
Case 8
Range(WS_RANGE).ColorIndex = 7
Case 9
Range(WS_RANGE).ColorIndex = 42
Case 10
Range(WS_RANGE).ColorIndex = 13
Case 11
Range(WS_RANGE).ColorIndex = 48
Case 12
Range(WS_RANGE).ColorIndex = 4
End Select

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Font

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 2
Case 2
Range(WS_RANGE).ColorIndex = 1
Case 3
Range(WS_RANGE).ColorIndex = 2
Case 4
Range(WS_RANGE).ColorIndex = 1
Case 5
Range(WS_RANGE).ColorIndex = 6
Case 6
Range(WS_RANGE).ColorIndex = 6
Case 7
Range(WS_RANGE).ColorIndex = 1
Case 8
Range(WS_RANGE).ColorIndex = 1
Case 9
Range(WS_RANGE).ColorIndex = 1
Case 10
Range(WS_RANGE).ColorIndex = 2
Case 11
Range(WS_RANGE).ColorIndex = 3
Case 12
Range(WS_RANGE).ColorIndex = 1
End Select


Application.ScreenUpdating = True
Application.Cursor = xlDefault
On Error GoTo 0
End Sub




"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what
the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be
appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

Nothing has changed.

I need to affect a color change in a cell that is in a range of 12 cells
based on an auto-populated value.

Cell range o5:o28
Cells are merged to equate to only 12 cells, o5, o7, o9 etc.
There are 12 identically formatted sheets that have this range on them yet
the sheet names are different. R1, R2, R3, etc.

EXCEPTION: The user cannot hit enter to cause the change.

Sorry for the confusion and the 'goalpost' reaction.

I did not ask for an Event. That was offered to me by Shane and you. I did
not work. The user would have to enter the value and press enter.

The merged cells was nothing but a clarification as to what the col of cells
were.

The 'End of a very large macro' comment was nothing but a comment to let you
know I had tried to place some code in the data analysis macro that runs this
entire routine.

Shu



"Bob Phillips" wrote:

Sorry but it is impossible to keep up with you, you are moving the goalposts
continually. First it was event code, then merged cells, then it is at the
end of a large macro.

You have lost me.

--
__________________________________
HTH

Bob

"Shu of AZ" wrote in message
...
Here is my latest attempt in solving this issue. The code is at the end
of a
very large macro

' The next line is the declaration at the start of the macro
Const WS_RANGE = "O5:O43"

' Code at the end of Macro ( Please remember I have 12 sheets, R1 thru
R12
that this has to work on.)

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Interior

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 3
Case 2
Range(WS_RANGE).ColorIndex = 2
Case 3
Range(WS_RANGE).ColorIndex = 41
Case 4
Range(WS_RANGE).ColorIndex = 6
Case 5
Range(WS_RANGE).ColorIndex = 50
Case 6
Range(WS_RANGE).ColorIndex = 1
Case 7
Range(WS_RANGE).ColorIndex = 46
Case 8
Range(WS_RANGE).ColorIndex = 7
Case 9
Range(WS_RANGE).ColorIndex = 42
Case 10
Range(WS_RANGE).ColorIndex = 13
Case 11
Range(WS_RANGE).ColorIndex = 48
Case 12
Range(WS_RANGE).ColorIndex = 4
End Select

Worksheets(R12).Select
Range(WS_RANGE).Select
Selection.Font

Select Case Range(WS_RANGE).Value
Case ""
Range(WS_RANGE).ColorIndex = xlNone
Case 1
Range(WS_RANGE).ColorIndex = 2
Case 2
Range(WS_RANGE).ColorIndex = 1
Case 3
Range(WS_RANGE).ColorIndex = 2
Case 4
Range(WS_RANGE).ColorIndex = 1
Case 5
Range(WS_RANGE).ColorIndex = 6
Case 6
Range(WS_RANGE).ColorIndex = 6
Case 7
Range(WS_RANGE).ColorIndex = 1
Case 8
Range(WS_RANGE).ColorIndex = 1
Case 9
Range(WS_RANGE).ColorIndex = 1
Case 10
Range(WS_RANGE).ColorIndex = 2
Case 11
Range(WS_RANGE).ColorIndex = 3
Case 12
Range(WS_RANGE).ColorIndex = 1
End Select


Application.ScreenUpdating = True
Application.Cursor = xlDefault
On Error GoTo 0
End Sub




"Shu of AZ" wrote:

Thanks Shane and Bob, the code works fine except it does not follow what
the
range is saying, the only cell that changes color is O5 and none of the
others react. Below is the final code. Any corrections would be
appreciated.

NOTE: I entered additional code to change the font colors as well.


Private Sub Worksheet_Change(ByVal Target As Range)
'-----------------------------------------------------------------
Const WS_RANGE As String = "O5:O43"

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Interior
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 3
Case 2: .ColorIndex = 2
Case 3: .ColorIndex = 41
Case 4: .ColorIndex = 6
Case 5: .ColorIndex = 50
Case 6: .ColorIndex = 1
Case 7: .ColorIndex = 46
Case 8: .ColorIndex = 7
Case 9: .ColorIndex = 42
Case 10: .ColorIndex = 13
Case 11: .ColorIndex = 48
Case 12: .ColorIndex = 4
End Select
End With
End If

On Error Resume Next
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target.Font
Select Case Target
Case "": .ColorIndex = xlNone
Case 1: .ColorIndex = 2
Case 2: .ColorIndex = 1
Case 3: .ColorIndex = 2
Case 4: .ColorIndex = 1
Case 5: .ColorIndex = 6
Case 6: .ColorIndex = 6
Case 7: .ColorIndex = 1
Case 8: .ColorIndex = 1
Case 9: .ColorIndex = 1
Case 10: .ColorIndex = 2
Case 11: .ColorIndex = 3
Case 12: .ColorIndex = 1

End Select
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

Continued Post - If statement and colors
 

Have you tried

Private Sub Worksheet_Calculate()

instead of the change event?


Gord Dibben MS Excel MVP

On Tue, 1 Jul 2008 15:29:01 -0700, Shu of AZ
wrote:

I did not ask for an Event. That was offered to me by Shane and you. I did
not work. The user would have to enter the value and press enter.

Continued Post - If statement and colors
 

Thanks Gord, I cannot get the code right to do even one cell. The problem is
if I knew how to write the code I wouldn't ask on this venue and truthfully,
I've just been getting tossed pieces of information and not the full
resolution so it is very difficult to learn from these boards.

When I write the code, the declarations are not working because to do Select
Case you have to indicate what it is you are looking for.

In my case, SaddleColor = WHAT? A range, that didnt work. What is it?
This was my futile attempt of just changing 3 cells in a range. It did
nothing.

Sub Macro3()

Dim SaddleColor As String

SaddleColor = "e7:e9"

Select Case SaddleColor

Case Is = 1
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
Selection.Font.ColorIndex = 2

End Select
End Sub




"Gord Dibben" wrote:

Have you tried

Private Sub Worksheet_Calculate()

instead of the change event?


Gord Dibben MS Excel MVP

On Tue, 1 Jul 2008 15:29:01 -0700, Shu of AZ
wrote:

I did not ask for an Event. That was offered to me by Shane and you. I did
not work. The user would have to enter the value and press enter.