ActiveX checkbox that changes color

[Olov]

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

 

[John_w]

Try this code.

Code in the ThisWorkbook module:

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:

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

 

[Olov]

Try this code.

Code in the ThisWorkbook module:

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:

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

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!

 

[Olov]

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!

 

[Olov]

I tried replacing 1 in OLEObjects(1) with "CheckBox1" and then it works.

 

[Olov]

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?

 

[Olov]

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?

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.

 

[John_w]

Thanks for posting your working solution.

Here's a better way to get the sheet's CheckBox1 ActiveX object, if it exists:

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.

 

[Olov]

Thanks for posting your working solution.

Here's a better way to get the sheet's CheckBox1 ActiveX object, if it exists:

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.

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.

 

[Olov]

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.