Insert a formated tick-cross into cell-vba

John Caines

Well-known Member
Joined
Aug 28, 2006
Messages
1,110
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
 

Some videos you may like

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,320
Office Version
365
Platform
Windows
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
Joined
Aug 28, 2006
Messages
1,110
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:

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
42,320
Office Version
365
Platform
Windows
How about
Code:
Sub ResetCells()
   Range("B2:B12").Clear
End Sub
 

John Caines

Well-known Member
Joined
Aug 28, 2006
Messages
1,110
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
Joined
Aug 28, 2006
Messages
1,110
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
Joined
Jun 12, 2014
Messages
42,320
Office Version
365
Platform
Windows
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
Joined
Jun 12, 2014
Messages
42,320
Office Version
365
Platform
Windows
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
Joined
Aug 28, 2006
Messages
1,110
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
Joined
Aug 28, 2006
Messages
1,110
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
 

Watch MrExcel Video

Forum statistics

Threads
1,101,746
Messages
5,482,608
Members
407,354
Latest member
Calvince

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top