Insert a formated tick-cross into cell-vba

John Caines

Well-known Member
Joined
Aug 28, 2006
Messages
1,155
Office Version
  1. 2019
Platform
  1. Windows
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;

Code:
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
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Try
Code:
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
 
Upvote 0
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
 
Last edited:
Upvote 0
How about
Code:
Sub ResetCells()
   Range("B2:B12").Clear
End Sub
 
Upvote 0
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. :)

Code:
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
 
Upvote 0
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
 
Upvote 0
You're missing a few commas
Code:
        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
 
Upvote 0
To clear the cells, select those you want to reset & use
Code:
Sub ResetCells()
   With Selection
      .Font.Name = "Arial"
      .Interior.Color = xlNone
      .Font.Color = vbBlack
      .ClearContents
   End With
End Sub
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,514
Messages
6,114,078
Members
448,547
Latest member
arndtea

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