View Full Version : Cell format

blastpwr1970

04-18-2007, 10:59 AM

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

04-18-2007, 11:27 AM

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

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

lenze

Simon Lloyd

04-18-2007, 11:44 AM

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

04-18-2007, 12:58 PM

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

04-18-2007, 03:16 PM

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

04-22-2007, 11:19 AM

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

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.