VBA Have cell color change when adding/removing check mark

Blooze

New Member
Joined
Apr 12, 2021
Messages
2
Office Version
  1. 2016
Platform
  1. Windows
I'm trying to combine code that will add/remove a check mark and change the color to yellow when the check mark is added and change it to no fill when removed. I know virtually nothing about VBA code though.



I have this code that adds/removes the checkmark fine:

VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Not Intersect(Target, Range("A7:A1000, J7:J1000,k7:k1000,l7:l1000")) Is Nothing Then

Application.EnableEvents = False

If ActiveCell.Value = ChrW(&H2713) Then

ActiveCell.ClearContents

Else

ActiveCell.Value = ChrW(&H2713)

End If

Cancel = True

End If

Application.EnableEvents = True

End Sub


I have this code which seems to work to change the color in another file (it's obviously not on double click though) . I would like to have the color change work with the double click as well.

VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)





'if cell fill is Blank, change to Yellow

If Target.Interior.ColorIndex = xlNone Then

Target.Interior.Color = RGB(255, 255, 0)

Exit Sub

End If



'if cell fill is Gray, change to Yellow

If Target.Interior.Color = RGB(242, 242, 242) Then

Target.Interior.Color = RGB(255, 255, 0)

Exit Sub

End If



'If cell fill is Yellow, remove fill color

If Target.Interior.Color = RGB(255, 255, 0) Then

Target.Interior.ColorIndex = xlNone

End If



End Sub
 

Excel Facts

Test for Multiple Conditions in IF?
Use AND(test, test, test, test) or OR(test, test, test, ...) as the logical_test argument of IF.
Hi & welcome to MrExcel.
How about
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

   If Not Intersect(Target, Range("A7:A1000, J7:J1000,k7:k1000,l7:l1000")) Is Nothing Then
      Application.EnableEvents = False
      If Target.Value = ChrW(&H2713) Then
         Target.Value = ""
         Target.Interior.ColorIndex = xlNone
      Else
         Target.Value = ChrW(&H2713)
         Target.Interior.Color = vbYellow
      End If
      Cancel = True
   End If
   
   Application.EnableEvents = True

End Sub
 
Upvote 0
Solution
Hi & welcome to MrExcel.
How about
VBA Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

   If Not Intersect(Target, Range("A7:A1000, J7:J1000,k7:k1000,l7:l1000")) Is Nothing Then
      Application.EnableEvents = False
      If Target.Value = ChrW(&H2713) Then
         Target.Value = ""
         Target.Interior.ColorIndex = xlNone
      Else
         Target.Value = ChrW(&H2713)
         Target.Interior.Color = vbYellow
      End If
      Cancel = True
   End If
  
   Application.EnableEvents = True

End Sub

That works perfectly! Thank you so much!
 
Upvote 0
You're welcome & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,251
Members
448,556
Latest member
peterhess2002

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