Set All Background Color Shape Based on Cell Value (with LOOP)

a_t_a · Nov 25, 2017

In Column A filled more than 1000 cell value (BAD or GOOD)
And I create 1000 shape with name Oval 1 oval 2 …. Oval n
I want set background shape color based on cell value (BAD or GOOD)
Example :
cell with GOOD value > Filled oval shape Background > set to GREEN color
cell with BAD value > Filled oval shape Background > set to RED color

i write macro( For 1000 cell , very confused and bored) :
Select Case Range("a2").Value
Case "BAD": ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbRed
Case "GOOD": ActiveSheet.Shapes("Oval 1").Fill.ForeColor.RGB = vbGreen
End Select
Select Case Range("a3").Value
Case "BAD": ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = vbRed
Case "GOOD": ActiveSheet.Shapes("Oval 2").Fill.ForeColor.RGB = vbGreen
End Select
file:
http://www.sharefile.ir/uploads/1511604550.zip

My Aswer Is This · Nov 25, 2017

Assuming you mean continue down column "A" till last cell with value
Starting in Row(2) column "A"

Try this:

Code:

Sub Fill_Oval()
'Modified 11-25-17 4:15 AM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To Lastrow
    
        MyVal = Cells(i, 1)
        With ActiveSheet.Shapes("Oval " & i - 1)
            Select Case MyVal
                Case "BAD"
                    .Fill.ForeColor.RGB = vbRed
                 Case "GOOD"
                    .Fill.ForeColor.RGB = vbGreen
            End Select
        End With
Next
Application.ScreenUpdating = True
End Sub

a_t_a · Nov 25, 2017

Tanx.Worked Perfect

My Aswer Is This · Nov 25, 2017

Glad I was able to help you. Come back here to Mr. Excel next time you need additional assistance.

a_t_a said:
Tanx.Worked Perfect

a_t_a · Nov 26, 2017

why not work when i chand column A to B

Code:

Lastrow = Cells(Rows.Count, "B").End(xlUp).Row

My Aswer Is This · Nov 26, 2017

Try this:
Assuming now you have GOOD BAD in column "B"
See code change marked in "Red"

Code:

Sub Fill_Oval()
'Modified 11-26-17 12:43 PM EST
Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Lastrow = Cells(Rows.Count, [COLOR=#ff0000]"B"[/COLOR]).End(xlUp).Row

For i = 2 To Lastrow
    
        MyVal = Cells(i, "[COLOR=#ff0000]B[/COLOR]")
        With ActiveSheet.Shapes("Oval " & i - 1)
            Select Case MyVal
                Case "BAD"
                    .Fill.ForeColor.RGB = vbRed
                 Case "GOOD"
                    .Fill.ForeColor.RGB = vbGreen
            End Select
        End With
Next
Application.ScreenUpdating = True
End Sub

Set All Background Color Shape Based on Cell Value (with LOOP)

a_t_a

New Member

Excel Facts

My Aswer Is This

Well-known Member

a_t_a

New Member

My Aswer Is This

Well-known Member

a_t_a

New Member

My Aswer Is This

Well-known Member

Similar threads

Forum statistics

Share this page

Set All Background Color Shape Based on Cell Value (with LOOP)

a_t_a

New Member

Excel Facts

My Aswer Is This

Well-known Member

a_t_a

New Member

My Aswer Is This

Well-known Member

a_t_a

New Member

My Aswer Is This

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock