Shape macro

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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
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
 

lukemason12

New Member
Joined
Aug 24, 2019
Messages
6
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.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
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:

lukemason12

New Member
Joined
Aug 24, 2019
Messages
6
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.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
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:

lukemason12

New Member
Joined
Aug 24, 2019
Messages
6
Than you Yongle I will give this a go.
 

lukemason12

New Member
Joined
Aug 24, 2019
Messages
6
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
Code:
Range("A5:A7") = Array(AA, BB, CC)
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,672
Office Version
365
Platform
Windows
Oops - half asleep :oops:
Let's try that again!

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

Forum statistics

Threads
1,082,135
Messages
5,363,344
Members
400,729
Latest member
Lisa McConachy

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top