color shapes based on cell value

[koi]

Hi All,

i really need help on this one since i cannot make it on recorder, and through searching i found several others threat here but i cannot use it in my case.

all i want is actually simple i think.. something like below

if Sheets("sheet2").Range("A1").Value = 1
then color Shapes("Rectangle 1") = Red
else
color Shapes("Rectangle 1") = transparent
end if

thanks for helping me

 

[Smallman]

Hi Koi

Give the following a try. I have attached a workbook to show workings.

Option Explicit
 
Sub testo()
Dim shp As Object
 
Set shp = Sheet1.Shapes("Rectangle 1")
    If Sheet2.[A1] = 1 Then
        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        shp.Fill.Visible = msoFalse
    End If
End Sub

Take care

Smallman

 

[Smallman]

Hi Koi

I have been playing around with the above as it seems that after the code changes the cell to transparent it won't change it back to a colour. Would changing it to white be OK? In that case this.

Option Explicit
 
Sub testo()
Dim shp As Object
 
Set shp = Sheet1.Shapes("Rectangle 1")
    If Sheet2.[A1] = 1 Then
        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)
    Else
        shp.Fill.ForeColor.RGB = RGB(255, 255, 255)
    End If
End Sub

Take care

Smallman

 

[koi]

hi Smallman,

thanks for helping and yes it's not working since i need the transparent (this is the most difficult things i believe),

will have to think another way of doing it.. thanks2

 

[KenU]

@koi,

@Smallman was almost there; only one line needed as shown. I have only included the added line with two original lines to show the position.

    If Sheet2.[A1] = 1 Then
        shp.Fill.Visible = msoTrue
        shp.Fill.ForeColor.RGB = RGB(255, 0, 0)

Hope that helps.

Regards,
Ken

By the way, this should be used in the code from his first post.

 

[koi]

wow, it worked .. thanks Ken !