Shape formatting

[Corleone]

Software: Excel365

Hi im using the following code to try and get a shape to change colour based on the text in Cell "C8"
The code is contained in the worksheet tab

however, when testing it out by typing in either Red, green or yellow i get an error message - "wrong number of assignments or invalid property assignment"

Private Sub WORKSHEET_CHANGE(ByVal TARGET As Range)
If Range("C8") = "RED" Then
ActiveSheet.Shapes.Range.Fill(Array("RUGELEY")).Select
Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Else

If Range("C8") = "GREEN" Then
ActiveSheet.Shapes.Range.Fill(Array("RUGELEY")).Select
Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6

Else

If Range("C8") = "YELLOW" Then
ActiveSheet.Shapes.Range.Fill(Array("RUGELEY")).Select
Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4

End If
End If
End If

ActiveSheet.Cells(8, 3).Select

End Sub


Thanks

 

[My Aswer Is This]

Try this:

Private Sub WORKSHEET_CHANGE(ByVal TARGET As Range)
'Modified  5/19/2022  9:47:41 AM  EDT
If TARGET.Address = "$C$8" Then

Select Case TARGET.Value
    Case "RED"
        ActiveSheet.Shapes.Range(Array("RUGELEY")).Select
        Selection.ShapeRange.Fill.ForeColor.RGB = RGB(255, 0, 0)

Case "GREEN"
    ActiveSheet.Shapes.Range(Array("RUGELEY")).Select
    Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6

Case "YELLOW"
    ActiveSheet.Shapes.Range(Array("RUGELEY")).Select
    Selection.ShapeRange.Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4

End Select


Cells(8, 3).Select
End If
End Sub

 

[Fluff]

Ok, how about

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Shp As String
   Dim Ary As Variant
  
   Ary = Array("RUGELEY", "MACC")
   If Target.CountLarge > 1 Then Exit Sub
   If Not Intersect(Target, Range("C8:C9")) Is Nothing Then
      Shp = Ary(Target.Row - 8)
      Select Case Target.Value
         Case "RED"
            Me.Shapes(Shp).Fill.ForeColor.RGB = RGB(255, 0, 0)
         Case "GREEN"
            Me.Shapes(Shp).Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6
         Case "YELLOW"
            Me.Shapes(Shp).Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4
      End Select
   End If
End Sub

 

[Corleone]

Private Sub Worksheet_Change(ByVal Target As Range) Dim Shp As String Dim Ary As Variant Ary = Array("RUGELEY", "MACC") If Target.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("C8:C9")) Is Nothing Then Shp = Ary(Target.Row - 8) Select Case Target.Value Case "RED" Me.Shapes(Shp).Fill.ForeColor.RGB = RGB(255, 0, 0) Case "GREEN" Me.Shapes(Shp).Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent6 Case "YELLOW" Me.Shapes(Shp).Fill.ForeColor.ObjectThemeColor = msoThemeColorAccent4 End Select End If End Sub

Yes - This is a more elegant solution to the one i had come up with as i can extend the range without worrying about the order changing if i sort them
once again thanks for your help

 

[My Aswer Is This]

I have found a workaround by creating separate macros for each shape and then creating another macro which runs them all simultaneously
Many thanks for your help

I believe this could be done with different shape names all in the same sub.

Show us the new code you are using for the other shapes

 

[Fluff]

as i can extend the range without worrying about the order changing if i sort them

The order of the shape names needs to be the same as the order of the cells, otherwise you will highlight the wrong shape.

 

[Corleone]

The order of the shape names needs to be the same as the order of the cells, otherwise you will highlight the wrong shape.

Noted! - Cheers

 

[Fluff]

You're welcome & thanks for the feedback.