Updating Objects in Different Groups in the One Worksheet

[Roybzer]

I have a worksheet where a map has been created using a number of freeform objects.

Each of these objects has been assigned the name of the territory which it represents.

I then have a list of each territory, with a reference to the fill colour required.

I have this working with the first map on the worksheet, however, each sheet will have up to 5 maps, all with the same territory names.

As I am working on a Mac, the auto-update does not work on the worksheet code, however, having assigned the code to a button is a viable workaround.

I have changed the range to a single cell for the simplicity of the example:

Sub Worksheet_Change_Object_Colour()

Dim target As Range

Set target = ActiveSheet.Range("X1")

If target <= 1 Then
ActiveSheet.Shapes.Range("Object1").Fill.ForeColor.RGB = RGB(255, 0, 0)
ElseIf target >= 100 And target <= 2 Then
ActiveSheet.Shapes.Range("Object1").Fill.ForeColor.RGB = RGB(0, 255, 0)
Else
ActiveSheet.Shapes.Range("Object1").Fill.ForeColor.RGB = RGB(0, 0, 255)
End If

End Sub

If you have multiple groups of all of these shapes, is there a way to reference a particular object from a specified group? e.g. group.range("Group3").shapes.range("Object1")

 

[Roybzer]

I've changed my approach on this one to generate a map on a different worksheet, then manually copy the result to the required sheet.

A little cumbersome, but it works well enough for what's required.

This is the code that I ended up using:

Sub Change_Province_Colour()

Dim target As Range
Dim provinceColour As String

Set target = ActiveSheet.Range("D2:D69")

    'If target Is Nothing Then Exit Sub

        For Each cell In target
            
            provinceColour = cell.Offset(0, 2).Value
            
            Select Case provinceColour
            
            Case "Blue"
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(0, 0, 255)
                
            Case "Green"
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(0, 255, 0)
                
            Case "Orange"
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(255, 192, 0)
                
            Case "Purple"
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(112, 48, 160)
                
            Case "Red"
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(255, 0, 0)
                
            Case Else
                ActiveSheet.Shapes.Range(cell).Fill.ForeColor.RGB = RGB(0, 0, 0)
            
            End Select
            
        Next
        
End Sub

Happy if there's anyone eager to resolve the original query, however, this is good enough for now.