Insert a formated tick-cross into cell-vba

[John Caines]

Hello All.
I have a spreadsheet with about 450 cells that need to have a tick or a cross inserted into them.

I've found a great bit of code here;
https://www.extendoffice.com/documents/excel/4558-excel-tick-and-cross.html
which is 80% of what I would really like the vba to do,,,
code so far copied from website is;

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updateby Extendoffice
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B2:B12")) Is Nothing Then
            With Target
                .Font.Name = "Wingdings"
                .Font.Size = 12
                If .FormulaR1C1 = " û " Then
                    .FormulaR1C1 = "ü"
                Else
                    .FormulaR1C1 = " û "
                End If
            End With
        End If
        Cancel = True
    End If
End Sub

Thing is,, I really want the double click to insert a cross that has a red background (Fill) for the cell, with the cross actually formatted to white text colour.

I'd love the 'Tick' to be a Green background (Fill) colour with the tick colour being black.

Does anybody know how to tweak the above code so that it can be formatted to do this?
I haven't a scoobies!

Any help would be most appreciated.

John C

 

[Fluff]

Try

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updateby Extendoffice
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("B2:B12")) Is Nothing Then
            With Target
                .Font.Name = "Wingdings"
                .Font.Size = 12
                If .Value = " û " Then
                    .Value = "ü"
                    Target.Interior.Color = vbGreen
                    Target.Font.Color = vbBlack
                Else
                    .Value = " û "
                    Target.Interior.Color = vbRed
                    Target.Font.Color = vbWhite
                End If
            End With
        End If
        Cancel = True
    End If
End Sub

 

[John Caines]

Hello Fluff!!
Brilliant!!
Many thanks for this,,,,
All is good,,,,,great to be honest,,,

But just 1 thing if possible.
Is there a way to create another vba,,or add some code to this so I can 'CLEAR' the cells back to their original formatting?
At the moment the cells are either filled green or red with white or black ticks which is perfect.

But I really need to also reset the cell to it's original format,,, with no Green or Red fill tick or cross.
If I right click the cell now I can clear the contents of the cell, but it's new fill colour remains.

Not sure the best way to go about this.
Maybe it would need another bit of code to assign a button to clear cells?

I'm not sure how it can be done.
Many thanks again for your reply Fluff.

It's working great!

A very grateful
JohnC

Just To Add,
I quickly created a short screencam of the problem I'm facing, just thought it might help to make clear my issue.
Dropbox link is this;
https://www.dropbox.com/s/9yjcqegqcwhms72/clear-fills.mp4?dl=0

Many thanks again

 

[Fluff]

How about

Sub ResetCells()
   Range("B2:B12").Clear
End Sub

 

[John Caines]

Hi Fluff!
Thanks for your reply again,
I'll try that now.
I've just adjusted your code to include all my cells for the ticks/crosses.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'Updateby Extendoffice
    If Target.Cells.Count = 1 Then
        If Not Intersect(Target, Range("F4:I7,K4:N7,P2:S7,U2:X7,Z2:AC7,AE2:AH7,AJ2:AM7" & _
        "F10:I13,K10:N13,P10:S13,U10:X13,Z10:AC13,AE10:AH13,AJ10:AM13" & _
        "F18:I21,K18:N21,P18:S21,U18:X21,Z18:AC21,AE18:AH21,AJ18:AM21" & _
        "F24:I27,K24:N27,P24:S27,U24:X27,Z24:AC27,AE24:AH27,AJ24:AM27")) Is Nothing Then
            With Target
                .Font.Name = "Wingdings"
                .Font.Size = 12
                If .Value = " û " Then
                    .Value = "ü"
                    Target.Interior.Color = vbGreen
                    Target.Font.Color = vbBlack
                Else
                    .Value = " û "
                    Target.Interior.Color = vbRed
                    Target.Font.Color = vbWhite
                End If
            End With
        End If
        Cancel = True
    End If
End Sub

I was trying to be clever here, I googled how to break links in vba so I didn't haver a really long line of cell refernces.
Thing is it now doesn't work!
Its got to be something really small that I've done wrong here.
Everytime I try It all highlights yellow in vba!

Any ideas Fluff?

I've been to several websites,,,I can't be too far off!
Many thanks again.
I'll try your button to clear macro now.
A very grateful
John c

 

[John Caines]

Hi Fluff,
Just to add,
I did try your clear button macro,,, which does clear the range of cells,, but for some reason it also is deleting some of the border lines of the cells!

I done a real quick screen cam here;
Dropbox link:
https://www.dropbox.com/s/rktn1ccvveiwzld/clear-deletes-borders.mp4?dl=0

Maybe if I can click on a button to somehow enable,,, then I can click on cells individually that I want to clear,, then when done, click the macro button again to turn it off....jsut speaking aloud,,,
I think that would be ideal Fluff.

It's just that I don't think I want to clear the whole range of cells,, just cells individually without it affecting the border formatting of the cells, like it seems to be doing in the video.

Many thanks again for all your help.

Very much appreciated.

It's almost there!
Yours sincerely
John C

 

[Fluff]

You're missing a few commas

        If Not Intersect(Target, Range("F4:I7,K4:N7,P2:S7,U2:X7,Z2:AC7,AE2:AH7,AJ2:AM7[COLOR=#ff0000],[/COLOR]" & _
        "F10:I13,K10:N13,P10:S13,U10:X13,Z10:AC13,AE10:AH13,AJ10:AM13[COLOR=#ff0000],[/COLOR]" & _
        "F18:I21,K18:N21,P18:S21,U18:X21,Z18:AC21,AE18:AH21,AJ18:AM21[COLOR=#ff0000],[/COLOR]" & _
        "F24:I27,K24:N27,P24:S27,U24:X27,Z24:AC27,AE24:AH27,AJ24:AM27")) Is Nothing Then

 

[Fluff]

To clear the cells, select those you want to reset & use

Sub ResetCells()
   With Selection
      .Font.Name = "Arial"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub

 

[John Caines]

Dam!!!!!!
I'm 100%,, well 90% sure I tried that Fluff!
I tried it with commas at the end,,, man,,, that's really got me now!

Many thanks again,,

At least that parts working now,,,

You've just saved my sanity!
It was driving me mad!


Just really want to clear individual cells now if possible with some sort of macro button (click),, then it will be perfect!

Thanks again for your help on this Fluff

Best regards
JohnC

 

[John Caines]

Hi Fluff,,,,,
Just seen your other code for the clear button.
Works a treat!!! Really brilliant!
Just what was needed.

Many thanks for this.

Really appreciated.
It's looking good now.
Couldn't have done it without your help

This VBA is so powerful,,, but it's a minefield if you're not a coder.

Thanks again Fluff

Have a great evening

A very grateful
John C