Change the shape colour

[rashmiranjan86]

Hi All,
I am preparing a dashboard where I have 100 square shapes in sheet 1. In Sheet 2 Cell A1, I have the total number of books. I wanted to colour the shapes based on the cell value.
e.g. if I am putting 10 in Sheet2 Cell A1, then Sheet1 out of 100 square shapes, first 10 shapes should change the colour to orange and rest will remain as it it. Is it possible?

 

[Siddharth Rout]

Yes, it is possible but for that ensure that the shapes have a particular naming format. For example "Rectangle 1","Rectangle 2","Rectangle 3" and so on...

Is this what you are trying?

Option Explicit

Sub Sample()
    Dim wsA As Worksheet, wsB As Worksheet
   
    '~~> Change these to relevant sheets
    Set wsA = Sheet1: Set wsB = Sheet2
   
    Dim i As Long
    Dim MaxShpNo As Long
   
    '~~> Check if there is a value in A1 of Sheet2
    If Len(Trim(wsB.Range("A1").Value2)) <> 0 Then
        '~~> Check if the value is greater than 0
        If Val(wsB.Range("A1").Value2) > 0 Then
            '~~> Get the max value
            MaxShpNo = Val(wsB.Range("A1").Value2)
            '~~> Loop through the shapes and color the shapes to orange
            For i = 1 To MaxShpNo
                '~~> Change name of shape here
                wsA.Shapes("Rectangle " & i).Fill.ForeColor.RGB = RGB(255, 165, 0)
            Next i
        End If
    End If
End Sub