Trouble with changing autoshape colours via cell drop down options

[Zero_Eclipse]

Hi all,

I am currently attempting to build a strategic assesment report for my department using Windows XP MS Excel 2003; unfortunately the requirement is for an automated system without buying an off the shelf package and quite frankly this has caused me sleepless nights, as I have never worked with visual basic before, and teaching myself over the last few days has achieved very little.

I have a workbook with multiple worksheets, on each worksheet (2 onwards) cells C21 to C23 contain dropdown lists (created via validation and have corresponding conditional formatting (R.A.G)). The drop downs list High, Medium or Low as options and the cells will turn Red, Amber or Green accordingly. On worksheet 1 there are Traffic lights (drawn using autoshapes and one for each worksheet). Cell C21 on each sheet will link to the first bulb in a corresponding traffic light image. Cell C22 links to the second bulb and Cell C23 links to the third bulb. Each bulb needs to turn Red, Amber or Green when the corresponding cell is selected as High, Medium or Low.

I have tried pasting the below into view code on each worksheet amending as required to match the worksheet and autoshapes as required, but to no avail.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$21" Then
'Change autoshape color to red, amber or green depending upon cell value.
With WorksheetSheet1.Shapes("Autoshape 6").Fill.ForeColor
If Target.Value = "High" Then
.SchemeColor = 3
ElseIf Target.Value = "Medium" Then
.SchemeColor = 45
ElseIf Target.Value = "Low" Then
.SchemeColor = 51
End If
End With
End If

If Target.Address = "$C$22" Then
'Change autoshape color to red, amber or green depending upon cell value.
With WorksheetSheet1.Shapes("Autoshape 2").Fill.ForeColor
If Target.Value = "High" Then
.SchemeColor = 3
ElseIf Target.Value = "Medium" Then
.SchemeColor = 45
ElseIf Target.Value = "Low" Then
.SchemeColor = 51
End If
End With
End If

If Target.Address = "$C$23" Then
'Change autoshape color to red, amber or green depending upon cell value.
With WorksheetSheet1.Shapes("Autoshape 3").Fill.ForeColor
If Target.Value = "High" Then
.SchemeColor = 3
ElseIf Target.Value = "Medium" Then
.SchemeColor = 45
ElseIf Target.Value = "Low" Then
.SchemeColor = 51
End If
End With
End If

End Sub

Please can anyone help me as I really am struggling.

 

[Andrew Poulsom]

Welcome to MrExcel.

This:

With WorksheetSheet1.Shapes("Autoshape 6").Fill.ForeColor

should be:

With Worksheets("Sheet1").Shapes("Autoshape 6").Fill.ForeColor

 

[Zero_Eclipse]

Andrew,

Thank you for responding to my plea for help.

I have amended the coding as you stated; however it now registers a Compile Error: Sub or Function not defined for the below section of coding. Any suggestions?

Private Sub Worksheet_Change(ByVal Target As Range)

 

[Andrew Poulsom]

This compiled fine for me:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$C$21" Then
    '   Change autoshape color to red, amber or green depending upon cell value.
        With Worksheets("Sheet1").Shapes("Autoshape 6").Fill.ForeColor
            If Target.Value = "High" Then
                .SchemeColor = 3
            ElseIf Target.Value = "Medium" Then
                .SchemeColor = 45
            ElseIf Target.Value = "Low" Then
                .SchemeColor = 51
            End If
        End With
    End If
 
    If Target.Address = "$C$22" Then
    '   Change autoshape color to red, amber or green depending upon cell value.
        With Worksheets("Sheet1").Shapes("Autoshape 2").Fill.ForeColor
            If Target.Value = "High" Then
                .SchemeColor = 3
            ElseIf Target.Value = "Medium" Then
                .SchemeColor = 45
            ElseIf Target.Value = "Low" Then
                .SchemeColor = 51
            End If
        End With
    End If
 
    If Target.Address = "$C$23" Then
'       Change autoshape color to red, amber or green depending upon cell value.
        With Worksheets("Sheet1").Shapes("Autoshape 3").Fill.ForeColor
            If Target.Value = "High" Then
                .SchemeColor = 3
            ElseIf Target.Value = "Medium" Then
                .SchemeColor = 45
            ElseIf Target.Value = "Low" Then
                .SchemeColor = 51
            End If
        End With
    End If
End Sub

 

[Zero_Eclipse]

Using the above a run time error '9': Subscript out of range message now appears in relation to all text stating - With Worksheets("Sheet1").Shapes("Autoshape 6").Fill.ForeColor

I am assuming that this is because autoshapes 6, 2 & 3 are contained within worksheet 1; whilst cell references C21:23 are all on worksheet 2.

Sorry about this, but my VB coding is extremely basic and I am probably well off the mark, but I have no other ideas why the autoshapes aren't responding to the code.

 

[Andrew Poulsom]

If you are getting a subscript out of range error, either there isn't a worksheet named Sheet1 in the active workbook, or a shape named Autoshape 6 doesn't exist on that worksheet.

 

[Zero_Eclipse]

Issue resolved, it was me being dense.

Thank you so much, your a star!

 

[Zero_Eclipse]

Apologies, I thought I had managed to resolve this issue. The colours do change on the traffic lights, unfortunately they do not turn Red, Amber or Green as per the MS Excel 2003 pallette codes. I have tried all 52 options available, Red and Green are within the 52 but do not correspond to the correct numbers and there is no option for Amber only a shad of yellow. The other colours range from white, black, blue, turquoise, brown and shades of purple. Can anyone explain why?

 

[Andrew Poulsom]

A SchemeColor is ColorIndex + 7. So red is 10, green is 17 and gold is 51.

 

[Zero_Eclipse]

Andrew,

Many thanks, the code works as you stated. One further question, if I wanted a specific pallette colour from the normal 52 MS Excel 2003 colors, how do I code for that, as currently it returns an error when using the amber and particular shade of green (colors 45 & 51), but the +7 takes this out of the range MS Excel 2003 recognises. Any ideas?