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
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,369
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
6,369
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
6,369
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
6,369
Office Version
365
Platform
Windows
Code:
Range("A5:A7") = Array(AA, BB, CC)
 

Yongle

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

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

Watch MrExcel Video

Forum statistics

Threads
1,102,778
Messages
5,488,821
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top