Colour of shape not changing

[swapnilk]

Hi,

I downloaded a excel file which uses VBA to change color of shapes as per values entered in Column A. However, the colour of shape 'M11' does not change based on cell value in reference 'A14'. The colour of all shapes change based on the value in cell A4 to A15.

Can someone please help me with the file and fix it so that the colour of shape M11 changes as per value in cell A14.

The excel file can be downloaded from here: https://gramener.com/uistatic/map/goa_tehsils.xlsm

Thanks in advance.

 

[swapnilk]

 

[NdNoviceHlp]

Perhaps the cell formatting is different... text not value? Dave

 

[Snakehips]

@swapnilk The problem is that the shape shown blue is actually a group of shapes. The mainland chunk and some very small islands.
The name of the Group is M11. the Name of the elements within appear to be ID_10, ID_11, ID_12, ID_14. (not sure about ID_13?)
So your code never finds a shape named M11.
Try changing M11 in B14 to ID_14 and the colour of the mainland bit will change as you are expecting.

Only you can decide your solution going forward.
Ungroup M11 and delete the tiny islands if seen as unimportant and rename the mainland portion?
Create a united single shape that can be named M11?
Revisit the coding to look for and process individual elements of a group?

HTH

 

[swapnilk]

Hi,

Perhaps the cell formatting is different... text not value? Dave

Hi, i checked the formatting, it is same for all the cells from A4 to A15.

@swapnilk The problem is that the shape shown blue is actually a group of shapes. The mainland chunk and some very small islands.
The name of the Group is M11. the Name of the elements within appear to be ID_10, ID_11, ID_12, ID_14. (not sure about ID_13?)
So your code never finds a shape named M11.
Try changing M11 in B14 to ID_14 and the colour of the mainland bit will change as you are expecting.

Only you can decide your solution going forward.
Ungroup M11 and delete the tiny islands if seen as unimportant and rename the mainland portion?
Create a united single shape that can be named M11?
Revisit the coding to look for and process individual elements of a group?

HTH

What you said solved the issue. Thanks.

However, i have observed that the color is actually changing but is not visible. For example if i right click on the blue colored shape in the image posted above and select Format Shape>Shape Options>Fill and change it from 'Solid' to 'No Fill' and then back to 'Solid' the color changes as per the value in cell A14. So somehow the shape color fill is getting refreshed only when i change the Shape Fill to 'No Fill' and then back to 'Solid'. No idea why that is happening.

 

[Snakehips]

 

[Snakehips]

Try this amendment to your Change event code and I think it will work OK for the currently blue group of shapes.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim KeyCells As Range

    ' The variable KeyCells contains the cells that will
    ' cause an alert when they are changed.
    Set KeyCells = Range("A:A")

    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
           Is Nothing Then

        

        ' Get the range of colors for up to 255 cells (B-IV)
        Dim g(0 To 255)
        Dim v(0 To 255)
        For Each Cell In Range("B1:IV1")
            If Cell.value <> "" Then
                v(Cell.Column - 2) = Cell.value
                g(Cell.Column - 2) = RGBval(Cell)
                n = Cell.Column - 1
            End If
        Next

        For Each Cell In Target.Cells
            ShapeName = Cell.Offset(0, 1).Text
            If ShapeName <> "" Then
                Set Shape = ActiveSheet.Shapes(ShapeName)
                
                With Shape.Fill
                    .ForeColor.RGB = Gradient(Cell.value, g, v, n)
                    .Visible = msoTrue
                    .Transparency = 0
                    .Solid
                End With
            End If
            '**********Dealing with a Group
            If Shape.Type = 6 Then  'is a group of shapes
                For Each Shp In Shape.GroupItems
                    With Shp.Fill
                    .ForeColor.RGB = Gradient(Cell.value, g, v, n)
                    .Visible = msoTrue
                    .Transparency = 0
                    .Solid
                End With
                Next
            End If
            
        Next

    End If
End Sub