VBA CODE TO CHANGE SHAPE COLOUR BASED ON CELL VALUE

[kumshan450]

I am currently working in a project where i have change the district color based on its cell value.

For eg in Sikkim state, there are 4 districts.

NORTH SIKKIM DISTIRCT MAP SHOULD CHANGE TO NORMAL COLOUR (GREY) AS ITS VALUE IS LESS THAN 1000
EAST SIKKING DISTRICT MAP SHOULD CHANGE TO BLUE COLOUR AS ITS VALUE IS GREATER THAN 1000
ANS SO FOR REST OF THE TWO DISTRICTS.

ANYTHING GREATER THAN OR EQUAL TO 1000 DISTRICT MAP SHAPE SHOULD CHANGE TO BLUE COLOUR OTHERWISE GREY.

ID	Value	DISTRICT
M1	300​	NORTH SIKKIM
M2	200​	WEST SIKKIM
M3	1000​	SOUTH SIKKIM
M4	50000​	EAST SIKKIM

THERE ARE 4 SHAPES IN ASSAM DISTRICTS. ALL SHAPES ARE NAMED BY M1, M2, M3 and M4

VBA CODE

Private Sub CommandButton1_Click()
For i = 1 To 5
API = Sheet1.Cells(i + 1, 2)
Select Case API
Case Is < 1000
Sheet1.Shapes.Range(Array("M" & i)).Fill.ForeColor.RGB = RGB(255, 0, 0)
Case Else
Sheet1.Shapes.Range(Array("M" & i)).Fill.ForeColor.RGB = RGB(255, 50, 0)
End Select
Next i
End Sub

I am trying to import above code but i am getting error - Run time error 1004 The item with the specified name wasn't found.

 

[KOKOSEK]

Change shapes name from M1 to M5 into x_M1 to x_M5 and then with:

With Sheet1
    For i = 1 To 5
        API = .Cells(i + 1, 2)
        Select Case API
            Case Is < 1000
                .Shapes("x_" & .Cells(i + 1, 1).Value).Fill.ForeColor.RGB = RGB(255, 0, 0)
            Case Else
                .Shapes("x_" & .Cells(i + 1, 1).Value).Fill.ForeColor.RGB = RGB(255, 255, 0)
        End Select
    Next i
End With

will work.

 

[Fluff]

Hi & welcome to MrExcel.

ALL SHAPES ARE NAMED BY M1, M2, M3 and M4

How? You cannot name a shape with something like M1 as it is a valid range reference.

 

[kumshan450]

Change shapes name from M1 to M5 into x_M1 to x_M5 and then with:

With Sheet1
    For i = 1 To 5
        API = .Cells(i + 1, 2)
        Select Case API
            Case Is < 1000
                .Shapes("x_" & .Cells(i + 1, 1).Value).Fill.ForeColor.RGB = RGB(255, 0, 0)
            Case Else
                .Shapes("x_" & .Cells(i + 1, 1).Value).Fill.ForeColor.RGB = RGB(255, 255, 0)
        End Select
    Next i
End With

will work.

Thank you very much its working fine. Problem solved.

 

[kumshan450]

Hi & welcome to MrExcel.

How? You cannot name a shape with something like M1 as it is a valid range reference.

Yes we can give name to an shape object. Please find the file attached

 

[Fluff]

You can give them names, but those names cannot be valid range references like M1.
You cannot attach files here, as it is not allowed.