lukemason12

New Member
Joined
Aug 24, 2019
Messages
6
Hi all,

I am after a macro that when a button is clicked it changes the colour of a shape to say if the statement is complete, working towards or incomplete. I then need a cell to be linked to the cell so that if it is complete the cell shows 3, working towards 2, incomplete 1.

I have a macro that fills the shapes fine but I cannot work out how to make a cell change value depending on the shape colour. There are roughly 36 shapes per worksheet.

Any help would be great.

Thanks,
Luke
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Welcome to the forum

Try this
- shape linked to cell B1
- B1 value alternates between 1, 2 & 3
- shape colour alternates between Green, Blue & Red

To link a shape to cell B1 (amend to whichever cell you want to use)

- right click on any shape to select it
- in formula bar type =B1 and hit Enter key

Add this procedure to a module (amend colurs etc to whatever you prefer to use)

Code:
Sub ChangeColours()
    Dim cel As Range
    ActiveSheet.Shapes(Application.Caller).Select
    Set cel = Range(Selection.Formula)
   
        With Selection.ShapeRange.Fill.ForeColor
            Select Case .RGB
                Case RGB(255, 0, 0)
                    .RGB = RGB(0, 255, 0)
                    cel = 1
                Case RGB(0, 255, 0)
                    .RGB = RGB(0, 0, 255)
                    cel = 2
                Case Else:
                    .RGB = RGB(255, 0, 0)
                    cel = 3
            End Select
        End With
        cel.Select
End Sub

Assign procedure to shape
- right click on shape \ Assign Macro \ click on ChangeColours \ OK
 
Upvote 0
Hmmm i dont think this would work as I need the cell to change not the shape.


If I could get the value of the shape to be the cell value I think I could get this to work but at the moment I can only get the shape to reference a cell and not vis versa.
 
Upvote 0
Please explain EXACTLY what you want the user to do and what should then happen to the shape and what should happen to the cell
 
Last edited:
Upvote 0
I have a number of sheets. On each sheet there are shapes that have statements written in that need to be completed.

I have three buttons on the sheet that are assigned macros to colour the shapes to red if the statement is incomplete, orange if it is working towards and green if it has been completed.

What I want to be able to do is count how many statements have been completed, working towards or incomplete.

The easiest way would be to count the shapes but after reading a lot online it all says this can not be achieved as excel can’t see it as a colour.

So my idea was to link the shape to a cell so that when whichever button was clicked (incomplete 1, working towards 2, complete 3) a number would appear in the shape which would then be linked to a cell. This way I can then count from the cells how many 1,2 or 3s appear giving me a count on the statements.

Hope this makes sense.

Luke.
 
Upvote 0
A method to count the number of shapes containing each colour ...

1. Select the sheet containing the shapes
2. Run this macro - it creates a new sheet with the colour values of each shape

Code:
Sub GetColours()
    Application.ScreenUpdating = False
    Dim shp As Shape, ws As Worksheet, sh As Worksheet, r As Long
    Set sh = ActiveSheet
    Set ws = Worksheets.Add
    sh.Activate
    For Each shp In sh.Shapes
        shp.Select
        r = r + 1
        ws.Cells(r, 1).Resize(, 2) = Array(Selection.Name, Selection.ShapeRange.Fill.ForeColor)
    Next
    Selection.TopLeftCell.Activate
    ws.Activate
End Sub

My test include red, green, and blue shapes
The above VBA therefore returned these values
Rectangle 2 255
Rectangle 3 65280
Rectangle 4 16711680
etc

3. Next use those values and modify the macro below to count your 3 colours

Code:
Sub CountColours()
    Application.ScreenUpdating = False
    Const A = [COLOR=#ff0000]255[/COLOR], B = [COLOR=#00ff00]65280[/COLOR], C = [COLOR=#0000ff]16711680[/COLOR]
    Dim AA As Long, BB As Long, CC As Long
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
       shp.Select
       Select Case Selection.ShapeRange.Fill.ForeColor
          Case A: AA = AA + 1
          Case B: BB = BB + 1
          Case C: CC = CC + 1
       End Select
    Next shp
    Selection.TopLeftCell.Activate
    MsgBox AA & vbCr & BB & vbCr & CC
End Sub
 
Last edited:
Upvote 0
Hi Yondle,

This works quite well. Is there a way to paste the results onto the sheet instead of displaying it as a message box? Say cells A5,6,7.

Thanks for your help,

Luke
 
Upvote 0
Code:
Range("A5:A7") = Array(AA, BB, CC)
 
Upvote 0
Oops - half asleep :oops:
Let's try that again!

Code:
Range("A5:A7") = WorksheetFunction.Transpose(Array(AA, BB, CC))
 
Upvote 0

Forum statistics

Threads
1,213,511
Messages
6,114,054
Members
448,543
Latest member
MartinLarkin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top