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!
Hi,
You have to put the shape name in the cell next to column BK and use the code below placed in the sheet Lower module. The code will fail if the name in column BL is wrong.
If Target.Cells.Count > 1 Then Exit Sub
Dim ShpName As String
If Not Intersect(Target, Range("BK4:BK209")) Is Nothing Then
ShpName = Target.Offset(0, 1).Value 'get shape name from next column (BL)
If Target.Value = 1 Then
Me.Shapes(ShpName).Fill.ForeColor.RGB = vbRed
ElseIf Target.Value >= 2 And Target.Value < 3 Then
Me.Shapes(ShpName).Fill.ForeColor.RGB = vbYellow
Else
Me.Shapes(ShpName).Fill.ForeColor.RGB = vbGreen
End If
End If
End Sub
Thank you Catalin! Really helpful.
