Auto Fill Color of a particular Cell if conditions are put

[Akash]

Hi,

Is it possible that after putting some condition like

if a cell value is more than 50 it should Fill the Cell with Yello
Color if more than than 70 it should be Green if more than 90 it
should be Red.

If this can be done. If yes, then how it can be done.

Awaiting for ur help in this regards

Akash

 

[MrScience]

Note: This assumes you have contiguous data in column "A." You can
modify as necessary.

Sub fillBasedOnValue()

Dim myCell As Variant
Set myCell = Range("A2")

Do While Not IsEmpty(myCell)
Set nextcell = myCell.Offset(1, 0)

Select Case myCell

Case 51 To 69
myCell.Interior.Color = vbYellow

Case 70 To 90
myCell.Interior.Color = vbGreen

Case Is > 90
myCell.Interior.Color = vbRed

End Select

Set myCell = nextcell

Loop

MsgBox "File Done"

End Sub

 

[Akash]

Hi,

Thanks for the solution, the macro which u had given to me is working
very fine. But i want that the macro should run autometically, I mean
to say that i dont want to press the shortcut key every time to run the
macro.

i want the product of A & B in Column C

Now i want that if the product of coulmn C is between 51 To 69 then it
should be yellow in color and if the product is beween 70 To 90 it
should be autometically green color and if greater than 90 then it
should be Red Color.

I dont want to run the macro everytime. By you solution i have to run
it evertime after i calculate the value. Its not comming autometically.

Pls do help me by giving proper solution.

Regards

Akash

 

[Bob Phillips]

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:A10" '<=== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Range(WS_RANGE)) Is Nothing Then

With Target

Select Case .Value

Case 51 To 69: .Interior.ColorIndex = 6
Case 70 To 90: .Interior.ColorIndex = 3
Case Is > 90: .Interior.ColorIndex = 5

End Select

End With

End If

ws_exit:
Application.EnableEvents = True
On Error GoTo 0

End Sub


'This is worksheet event code, which means that it needs to be
'placed in the appropriate worksheet code module, not a standard
'code module. To do this, right-click on the sheet tab, select
'the View Code option from the menu, and paste the code in.


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Akash]

hii Bob,

thanks for the help but this is for your information that the following
code is not working

I have three columns

A B & C

i want the sum of A & B in C
More over I want that if the sum is greater than 50 but less that 60
the color of the cell should change to yellow and similar with other
conditions.

I want this type of program.

I hope i would definetely receive a solution from ur end.

Akash

 

[Bob Phillips]

Akash,

This should do it

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "A1:B10" '<=== change to suit

On Error GoTo ws_exit
Application.EnableEvents = False

If Not Intersect(Target, Range(WS_RANGE)) Is Nothing Then

With Target

If .Column = 1 Then
.Offset(0, 2).Value = .Value + .Offset(0, 1).Value
Call SetColour(.Offset(0, 2))
Else
.Offset(0, 1).Value = .Value + .Offset(0, -1).Value
Call SetColour(.Offset(0, 1))
End If

End With

End If

ws_exit:
Application.EnableEvents = True
On Error GoTo 0

End Sub

Private Sub SetColour(Target As Range)

Select Case Target.Value

Case 50 To 59: Target.Interior.ColorIndex = 6 'yellow
Case 60 To 69: Target.Interior.ColorIndex = 3 'red
Case 70 To 79: Target.Interior.ColorIndex = 10 'green
Case 80 To 89: Target.Interior.ColorIndex = 46 'orange
Case Is >= 90: Target.Interior.ColorIndex = 5 'blue

End Select

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Utsav]

Dear ,

Use conditional formatting for this it will be more helpful and much
easy.

I think u got my point.

Utsav

 

[Utsav]

Dear ,

Use conditional formatting for this it will be more helpful and much
easy.

I think u got my point.

Utsav

 

[Bob Phillips]

as long as he only has 3 conditions.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)