Cell format

[blastpwr1970]

Hi,

I need to to include the range from "I3:I6" in to "C24" format changing if the value of "F22" is lower that the values from "I3:I6", base on the drop down list.

If you open the workbook it will make more sense, I hope.

Thank you for all of your help in advance

[lenze]

Conditionally format I3:I6 like this. Use Formula is.

=(OFFSET(I3,0,-1)=$C$2)*($F$22<$I3)

lenze

[Simon Lloyd]

Conditional format would have been my first suggestion....but as it has been suggested here's an alternative added to your VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cel As Range
Dim Cel1 As Range
Dim MyValue As Variant
If Target.Cells.Count > 1 Then Exit Sub
Set Rng = Range("D5:D22,F5:F21")
If Not Intersect(Target, Range("D5:D22,F5:F21")) Is Nothing Then
With Range("C24")
For Each Cel In Rng
If Cel >= 150 Then
.Interior.ColorIndex = 3
.Value = "Out of Range"
Exit Sub
Else
.Interior.ColorIndex = xlNone
.Value = "OK"
End If
Next
End With
End If
For Each Cel1 In Range("I3:I6")

Select Case Cel1.Value
Case Is < Range("F22")
Cel1.Interior.ColorIndex = xlNone
Case Is > Range("F22")
Cel1.Interior.ColorIndex = 3
Cel1.Value = "Out of Range"
Exit Sub
End Select
Next Cel1
End Sub
Regards,
Simon

[Charlize]

Conditional format would have been my first suggestion....but as it has been suggested here's an alternative added to your VBA:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Cel As Range
Dim Cel1 As Range
Dim MyValue As Variant
If Target.Cells.Count > 1 Then Exit Sub
Set Rng = Range("D5:D22,F5:F21")
If Not Intersect(Target, Range("D5:D22,F5:F21")) Is Nothing Then
With Range("C24")
For Each Cel In Rng
If Cel >= 150 Then
.Interior.ColorIndex = 3
.Value = "Out of Range"
Exit Sub
Else
'Instead of xlNone I would use xlColorIndexNone
'In the past I have had some issues wit xlNone
'and colorindex. Cells colored grey instead of
'removing color.
.Interior.ColorIndex = xlNone
.Value = "OK"
End If
Next
End With
End If
For Each Cel1 In Range("I3:I6")

Select Case Cel1.Value
Case Is < Range("F22")
'xlColorIndexNone
Cel1.Interior.ColorIndex = xlNone
Case Is > Range("F22")
Cel1.Interior.ColorIndex = 3
Cel1.Value = "Out of Range"
Exit Sub
End Select
Next Cel1
End Sub
Regards,
SimonCharlize

[blastpwr1970]

I am sorry, I did not explain right. :help

I want to include "F22" in to the same cell formating of "F24".

If I change The pull down list from "C2" to "filter size -45" then it looks if "F22" is lower that "I3" and then it changes "C24" to "out of range" if is lower but of is higher then is "OK"

It need to be "Diameter" or "Min. total area" changes "C24" to "out of range" or "OK"

New revise attachment is included with sample in sheet 1.

Please let me know if it is confusing still.

Thank you for your patience

[blastpwr1970]

Hi,

I had to start a new thread because I marked "Cell formatting" as Solved is this the proper way to do it or should I continue in the solved one.

The problem I have is that every part works fine by itself but when I put it together it goes in to a loop for ever.

Is there an easier way to do it?
I would like to combine the diameter and the total area in to only one cell result of OK or Reject.

Please see attachment

Sub Worksheet_Change(ByVal Target As Range)
'======================================================================
'Test the Diameter
'This part is from (mdmackillop) thank you again for your help.
'======================================================================
If Target.Cells.Count > 1 Then Exit Sub
Dim Rng As Range
Dim Cel As Range
Dim TArea As Range

Set Rng = Range("D5:D22,F5:F21")
If Not Intersect(Target, Range("D5:D22,F5:F21")) Is Nothing Then
With Range("B25")
For Each Cel In Rng
If Cel >= 150 Then
.Interior.ColorIndex = 3
.Value = "Out of Range"
Exit Sub
Else
.Interior.ColorIndex = xlNone
.Value = "OK"
End If
Next
End With
End If

'====================================================================
' Test the Total Area Value
' This is my part, as you can see, I still got a long way to go.
'====================================================================
If Range("c2") = "Filter Size -45" And Range("F22") <= "212,874" Then
With Range("E25")
.Interior.ColorIndex = 3
.Value = "Out of Range"
End With
End If

If Range("c2") = "Filter Size -45" And Range("F22") > "212,874" Then
With Range("E25")
.Interior.ColorIndex = xlNone
.Value = "OK"
End With
End If

If Range("c2") = "Filter Size -55" And Range("F22") <= "237,752" Then
With Range("E25")
.Interior.ColorIndex = 3
.Value = "Out of Range"
End With
End If

If Range("c2") = "Filter Size -55" And Range("F22") > "237,752" Then
With Range("E25")
.Interior.ColorIndex = xlNone
.Value = "OK"
End With
End If

If Range("c2") = "Filter Size -65" And Range("F22") <= "175,929" Then
With Range("E25")
.Interior.ColorIndex = 3
.Value = "Out of Range"
End With
End If

If Range("c2") = "Filter Size -65" And Range("F22") > "175,929" Then
With Range("E25")
.Interior.ColorIndex = xlNone
.Value = "OK"
End With
End If

If Range("c2") = "Filter Size -75" And Range("F22") <= "167,243" Then
With Range("E25")
.Interior.ColorIndex = 3
.Value = "Out of Range"
End With
End If

If Range("c2") = "Filter Size -75" And Range("F22") > "167,243" Then
With Range("E25")
.Interior.ColorIndex = xlNone
.Value = "OK"
End With
End If

'================================================================
' Check if Diameter or Total Area is out of Range
' This one is also mine.
'================================================================
If Range("B25") = "OK" And Range("E25") = "OK" Then
With Range("B27")
.Interior.ColorIndex = 4
.Value = "Accept Part"
End With
End If

If Range("B25") = "Out of Range" And Range("E25") = "OK" Then
With Range("B27")
.Interior.ColorIndex = 3
.Value = "Reject Part"
End With
End If

If Range("B25") = "OK" And Range("E25") = "Out of Range" Then
With Range("B27")
.Interior.ColorIndex = 3
.Value = "Reject Part"
End With
End If
If Range("B25") = "Out of Range" And Range("E25") = "Out of Range" Then
With Range("B27")
.Interior.ColorIndex = 3
.Value = "Reject Part"
End With
End If
End Sub



Thank you for all your help