Ideas on how to make a big tick apear in a cell when i click on it?

[tonywatsonhelp]

Hi Everyone,

I'm open to ideas here but I very stuck.
Well have a Sheet that has a range in it that I made look like a big Graph of squares,
It Range is G15:Z45
Each cell is about 3 cm square so nice and big,
I want to be able to click on a cell and have it make a Tick appear or Disappear and put some data in a cell but don't know if this can even be done!

So Lets say you click on Cell H20, I want a big tick to appear in H20 over the Writing that's there, I thought maybe do this as a picture.
but I also need to remove the tick if its clicked again?
also I want the cell I've clicked on to offset 26 cells right and record the date.

If anyone can think of anything please let me know, I can do it with a single cell but not a range and that would be a lot of code lol.
Thanks
Tony

 

[MickG]

If you copy your range "G15:Z45", and paste it 101 columns to the right, then run this "SelectionChange" event, that should do what you want !!
NB:- Change offset as required, or possibly another sheet. !!

Private [COLOR="Navy"]Sub[/COLOR] Worksheet_SelectionChange(ByVal Target [COLOR="Navy"]As[/COLOR] Range)
[COLOR="Navy"]If[/COLOR] Not Intersect(Range("G15:Z45"), Target) [COLOR="Navy"]Is[/COLOR] Nothing [COLOR="Navy"]Then[/COLOR]
    Target.Value = IIf(Target.Value = ChrW(&H2713), Target.Offset(, 100), ChrW(&H2713))
    Target.Offset(, 26) = Date
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Yongle]

The easy bit - use a rectangle (or a label) with text value "P" and font "Windings 2" for the tick
Clicking on the rectangle could trigger its click_event macro to toggle its value between "P" and empty)

BUT the user is not able to edit the value in the cell, because the rectangle is now in the way
Q1 Should the click_event provide an option to edit the cell?

Q2 Is the date to be amended in .Offset(,26) cell EVERY time the TICK appears and disappears?

To make sure I am not missing anything, please describe exactly what should happen when a cell needs editing (does it affect the tick?) and also what should happen when the tick is toggled both ON and OFF

 

[tonywatsonhelp]

Hi Yongle thanks for your help.
The Text in the cell behind would not need to be changed, I'm going to link it to a control tab so If I have to edit any spelling change wording its easier but no one else needs to) the Idea of a Rectangle with text P is perfect as I can play around with colour etc.
everytime we click the rectangle / cell I need it to appear /disappear and record the date
hope that's everything
thanks for your help
Tony

 

[Yongle]

Try this on a copy of your workbook
- add the code and then click on the cells in G15:Z45 to see if it does what you want

Goes in sheet module
- right-click sheet tab \ select View Code \ paste code into code window

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Range("G15:Z45"), Target) Is Nothing Then
        Call AddTick(Target)
        Target.Offset(, 26) = Date
    End If
End Sub

Goes in standard module
{ALT}{F11} to get to VBA window
{ALT} I M to Insert Module
paste into code window

Sub RemoveTick()
    ActiveSheet.Shapes(Application.Caller).Delete
End Sub

Sub AddTick(ByVal Cel As Range)
    Dim shp As Shape
    With Cel
        Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
    End With
    With shp
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
        With .TextFrame2
            .VerticalAnchor = msoAnchorMiddle
            .HorizontalAnchor = msoAnchorCenter
        End With
        With .TextFrame.Characters
            .Text = "P"
            With .Font
                .Bold = True
                .ColorIndex = 3
                .Size = 25
                .name = "Wingdings 2"
            End With
        End With
    End With
    shp.OnAction = "'" & ActiveWorkbook.name & "'!RemoveTick"
End Sub

 

[tonywatsonhelp]

Yongle,
This is great, work first time on test page
Thank you very much for your help
Tony

 

[Yongle]

thanks for the feedback