Autocolor Shapes (>200 Shapes) with an unique value each one|VBA & Macros|Excel Forum|My Online Training Hub

Hello everyone,

Happy to see a big community that helps with issues that we can find in this magic tool that its excel. I would like to ask for some advice regarding VBA.

Im trying to represent a map from a mall

I would like to change the colour shape if the number of the column BK changes

I have tried using the following code that i found in this page from user Lionel Baijot

___________________________________________________________

Private Sub Worksheet_Calculate()
Dim target As Range
Set target = Range("H2")

If Not Intersect(target, Range("H2")) Is Nothing Then
If target.Value < 50 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbRed
ElseIf target.Value >= 51 And target.Value < 100 Then
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbYellow
Else
Sheets("Sheet1").Shapes("Rectangle: Rounded Corners 1").Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
___________________________________________________________

after that i included some additional changes... it worked but only with the first shape... (there are 200 shapes)

___________________________________________________________

Private Sub Worksheet_Calculate()

' #.1 - Lower - BK3 - .Name1 - Name of Tenant

Dim target As Range
Set target = Range("BK3")
If Not Intersect(target, Range("BK3")) Is Nothing Then
If target.Value = 1 Then
Sheets("Lower").Shapes(".Name1").Fill.ForeColor.RGB = vbRed
ElseIf target.Value >= 2 And target.Value < 3 Then
Sheets("Lower").Shapes(".Name1").Fill.ForeColor.RGB = vbYellow
Else
Sheets("Lower").Shapes(".Name1").Fill.ForeColor.RGB = vbGreen
End If
End If

' #.2 - Lower - BK209 - .Name4 - Name of Tenant 2

Dim target As Range
Set target = Range("BK4")
If Not Intersect(target, Range("BK4")) Is Nothing Then
If target.Value = 1 Then
Sheets("Lower").Shapes(".Name2").Fill.ForeColor.RGB = vbRed
ElseIf target.Value >= 2 And target.Value < 3 Then
Sheets("Lower").Shapes(".Name2").Fill.ForeColor.RGB = vbYellow
Else
Sheets("Lower").Shapes(".Name2").Fill.ForeColor.RGB = vbGreen
End If
End If

........

' #.200 - Lower - BK209 - .Name200 - Name of Tenant 200

Dim target As Range
Set target = Range("BK209")
If Not Intersect(target, Range("BK209")) Is Nothing Then
If target.Value = 1 Then
Sheets("Lower").Shapes(".Name200").Fill.ForeColor.RGB = vbRed
ElseIf target.Value >= 2 And target.Value < 3 Then
Sheets("Lower").Shapes(".Name200").Fill.ForeColor.RGB = vbYellow
Else
Sheets("Lower").Shapes(".Name200").Fill.ForeColor.RGB = vbGreen
End If
End If

____________________________________________________________________

I have no education regarding coding, as consequence im asking for some help...

Would you mind to help me if you have in mind the solution?

Thanks!