Insert a formated tick-cross into cell-vba

John Caines

Well-known Member
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
 

Fluff

MrExcel MVP, Moderator
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
 

John Caines

Well-known Member
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:

John Caines

Well-known Member
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
 

John Caines

Well-known Member
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

MrExcel MVP, Moderator
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
 

Fluff

MrExcel MVP, Moderator
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
 

John Caines

Well-known Member
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

Well-known Member
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
 

Some videos you may like

This Week's Hot Topics

  • Importing multiple excel files into one spreadsheet
    Hi, I'm trying to import multiple excel files (with the same format into a single spreadsheet) so that each day's file is listed underneath the...
  • find many based on a certain criteria
    good evening, I hope someone can help me? I have a workbook sheet 2 contains lots of data.... I would like to be able to find anything on sheet...
  • How to copy multiple rows using If
    Hi all, I'm very new to VBA and have written this simple code to copy certain cells if a certain cell within that row contains any data. I need...
  • VBA If statement
    Dear All, I have two dates, where I'd like a message box to pop, if the dates are between this criteria. [CODE] sDate1 = #10/1/2019#...
  • Text Format
    I have a sheet for user to keyin the data. The format of the data can be 451 / 1903, 0012 / 9908 or 00287 / 0099. The number after the "/" is...
  • Syntax errors
    Good Morning, Trying to compile a workbook, I keep getting a few errors. Here are the first two: [code=rich]Syntax Error: Function...
Top