ActiveX checkbox that changes color

O

Olov

New Member
Joined
Jan 17, 2024
Messages
19
Office Version
  1. 365
Platform
  1. Windows
Hi,
I want to have an ActiveX checkbox in each sheet that depending on whether the value in cell A1 is empty should be hidden and otherwise it should be red and not selected. When I'm done with the sheet, I should be able to click on the checkbox and it should turn green. If the color of the tab follows the color of the button, that would be great too. Then the color could be white when cell A1 is empty. I've made code that almost works. What goes wrong is when code Show_Notes is run, the checkbox and tab color sometimes turn red and when I change a value in the sheet, the checkbox and tab change color to red.
Sincerely, Olov

Private Sub Worksheet_Change(ByVal Target As Range)
If Range("$A$1").Value <> "" Then
Me.Tab.ColorIndex = 3 'red
CheckBox1.BackColor = &HFF& 'red
CheckBox1.Visible = True
Else
Me.Tab.ColorIndex = 2 'white
CheckBox1.Visible = False
End If
End Sub

Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then Me.Tab.ColorIndex = 4 'green
If CheckBox1.Value = True Then CheckBox1.BackColor = &HFF00& 'green
If CheckBox1.Value = False Then
CheckBox1.BackColor = &HFF& 'red
If Range("$A$1").Value <> "" Then
Me.Tab.ColorIndex = 3 'red
Else
Me.Tab.ColorIndex = 2 'white
End If
End If
End Sub


Sub Show_Notes()
Dim Ws As Worksheet
Dim Cmnt As Comment
Dim Count As Long
Application.ScreenUpdating = False
Sheets("Notes").Select
Sheets("Notes").Range("B4:D23").ClearContents
Count = 0
For Each Ws In ActiveWorkbook.Worksheets
For Each Cmnt In Ws.Comments
Worksheets("Notes").Range("B3").Offset(Count, 0).Parent.Hyperlinks.Add _
Anchor:=Worksheets("Notes").Range("B4").Offset(Count, 0), _
Address:="", _
SubAddress:="'" & Ws.Name & "'!" & Cmnt.Parent.Address, _
TextToDisplay:="'" & Ws.Name & "'!" & Cmnt.Parent.Address
Worksheets("Notes").Range("C4").Offset(Count, 0).Value = Cmnt.Author
Worksheets("Notes").Range("D4").Offset(Count, 0).Value = Cmnt.Text
Count = Count + 1
Next Cmnt
Next Ws
Rows("4:23").RowHeight = 25.5
Range("A2").Select
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Sort by date Sort by votes
Try this code.

Code in the ThisWorkbook module:
VBA Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim OLEobj As OLEObject

    With Sh
        If .OLEObjects.Count >= 1 Then
            Set OLEobj = .OLEObjects(1)
            If .Range("A1").Value <> "" Then
                .Tab.Color = vbRed
                OLEobj.Visible = True
                OLEobj.Object.Value = False
                OLEobj.Object.BackColor = vbRed
            Else
                .Tab.Color = vbWhite
                OLEobj.Visible = False
            End If
        End If
    End With

End Sub

Code in each sheet module:
VBA Code: 
Private Sub CheckBox1_Click()
    With Me
        If .OLEObjects(1).Object.Value = True Then
            .OLEObjects(1).Object.BackColor = vbGreen
            .Tab.Color = vbGreen
        Else
            .OLEObjects(1).Object.BackColor = vbRed
            .Tab.Color = vbRed
        End If
    End With
End Sub
 
Upvote 0
John_w said:
Try this code.

Code in the ThisWorkbook module:
VBA Code: 
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    Dim OLEobj As OLEObject

    With Sh
        If .OLEObjects.Count >= 1 Then
            Set OLEobj = .OLEObjects(1)
            If .Range("A1").Value <> "" Then
                .Tab.Color = vbRed
                OLEobj.Visible = True
                OLEobj.Object.Value = False
                OLEobj.Object.BackColor = vbRed
            Else
                .Tab.Color = vbWhite
                OLEobj.Visible = False
            End If
        End If
    End With

End Sub

Code in each sheet module:
VBA Code: 
Private Sub CheckBox1_Click()
    With Me
        If .OLEObjects(1).Object.Value = True Then
            .OLEObjects(1).Object.BackColor = vbGreen
            .Tab.Color = vbGreen
        Else
            .OLEObjects(1).Object.BackColor = vbRed
            .Tab.Color = vbRed
        End If
    End With
End Sub
Click to expand...
Thanks for the code. It works if I only have one activeX control on the tab. I also have CommandButton1 to CommandButton4 on some tabs. On these, the color of CommandButton1 changes just like that of CheckBox1.
Is it possible to control the code to CheckBox1?
Thanks in advance!
 
Upvote 0
Olov said:
Thanks for the code. It works if I only have one activeX control on the tab. I also have CommandButton1 to CommandButton4 on some tabs. On these, the color of CommandButton1 changes just like that of CheckBox1.
Is it possible to control the code to CheckBox1?
Thanks in advance!
Click to expand...
 
Upvote 0
I tried replacing 1 in OLEObjects(1) with "CheckBox1" and then it works.
 
Upvote 0
Is it possible to have all tabs that should be red be red when the condition, A1 <> "", is false without having to go into each tab and refresh?
 
Upvote 0
Olov said:
Is it possible to have all tabs that should be red be red when the condition, A1 <> "", is false without having to go into each tab and refresh?
Click to expand...
I replaced
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
with
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
Then it works the way I want.
 
Upvote 0
Thanks for posting your working solution.

Here's a better way to get the sheet's CheckBox1 ActiveX object, if it exists:
VBA Code: 
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    Dim cb1 As OLEObject

    With Sh
        On Error Resume Next
        Set cb1 = .OLEObjects("CheckBox1")
        On Error GoTo 0
        If Not cb1 Is Nothing Then
            If .Range("A1").Value <> "" Then
                .Tab.Color = vbRed
                cb1.Visible = True
                cb1.Object.Value = False
                cb1.Object.BackColor = vbRed
            Else
                .Tab.Color = vbWhite
                cb1.Visible = False
            End If
        End If
    End With

End Sub
This should be equivalent to your Workbook_SheetCalculate.
 
Upvote 0
John_w said:
Thanks for posting your working solution.

Here's a better way to get the sheet's CheckBox1 ActiveX object, if it exists:
VBA Code: 
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)

    Dim cb1 As OLEObject

    With Sh
        On Error Resume Next
        Set cb1 = .OLEObjects("CheckBox1")
        On Error GoTo 0
        If Not cb1 Is Nothing Then
            If .Range("A1").Value <> "" Then
                .Tab.Color = vbRed
                cb1.Visible = True
                cb1.Object.Value = False
                cb1.Object.BackColor = vbRed
            Else
                .Tab.Color = vbWhite
                cb1.Visible = False
            End If
        End If
    End With

End Sub
This should be equivalent to your Workbook_SheetCalculate.
Click to expand...
Thank you for that code, it will make it easier at a later stage.
Now all CheckBox1 that are green turn red when I enter values. Have turned off the calculation and then they do not turn red, when I turn on the calculation they turn red at once. Not so good.
Can the code be remade in any way do you think? If I make a change that affects another tab, it may turn red. Then you have to go in and make it green again and that is ok.
I work with a material specification that calculates in many tabs depending on the type of object I choose in different tabs.
 
Upvote 0
Hello again.
I added
If Not .Tab.Color = vbGreen Then
after
With Sh
and
End If
before
End Sub
Now they no longer turn red. The function that makes them red if something changes in the tab would be good to have.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Solved
Passing a checkbox object into a private sub doesn't work
Replies
2
Views
351
Arcadian
A
N
  • Question
ActiveX Checkbox fails after sheetname change
Replies
4
Views
228
bobsan42
bobsan42
E
  • Solved
Checkbox to ActiveX checkbox change in VBA
Replies
3
Views
291
Domenic
D
E
  • Solved
Macro to run anytime a ActiveX checkbox is used (no linked cells)
Replies
8
Views
463
John_w
J
G
  • Question
Activex Check Box VBA Code not working automatically
Replies
6
Views
340
ganeshadu
G

Forum statistics

Threads
1,216,500
Messages
6,131,016
Members
449,615
Latest member
Nic0la

Share this page

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