ActiveX CheckBox problem

[CrispyAsian]

Hello everyone,

I am having an issue with ActiveX Checkboxes but I don't know what the problem is or how to fix it. So I have a sheet like this:

[/URL][/IMG]

And I have a code running to make everyone in column B have their own sheet. However, I only want that to happen if the checkbox in column A is checked. So far I have this running:

Sub Exampleofmycode

Dim objControl As Object
Dim lastrow As String

ThisWorkbook.Sheets("Personnel").Activate

lastrow = ActiveSheet.Columns("B").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row

For Each c In ThisWorkbook.Sheets("Personnel").Range("B3:B" & lastrow)
    If c.Value <> "" Then
        For Each objControl In Sheets("Personnel").OLEObjects
            If TypeName(objControl.Object) = "CheckBox" Then
[COLOR=#ff0000]                If objControl.TopLeftCell.Row = c.Row Then[/COLOR]
                    If objControl.Object.Value = 1 Then
                         'Rest of the code goes here
                   End If
               End If
            End If
        Next 
     End If
Next c

End Sub

I ran through it and it never makes it past the line in red. It just jumps down to the End If. Does anybody know what I'm doing wrong?

 

[dmt32]

hi,
untested but see if this update to your code helps

Sub Exampleofmycode()


    Dim objControl As Object
    Dim lastrow As Long
    Dim c As Range
    
    With ThisWorkbook.Sheets("Personnel")
            .Activate
    lastrow = .Columns("B").Cells.Find("*", SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlPrevious).Row
    
    For Each c In .Range("B3:B" & lastrow)
        If c.Value <> "" Then
            For Each objControl In .OLEObjects
                If TypeName(objControl.Object) = "CheckBox" Then
                    If objControl.Top = c.Top Then
                        If objControl.Object.Value Then
                        
                             'Rest of the code goes here
                       End If
                   End If
                End If
            Next
         End If
    Next c
    End With
End Sub

Dave

 

[Norie]

Why not use Forms checkboxes?

If you did then you could use Application.Caller to identify the checkbox that has been checked/unchecked.

 

[Yongle]

An alternative method...

You could avoid the complication of check boxes

To test - create a new workbook
Place code below in the sheet module
Click in any cell in column A below row 2
Cell behaves like a check box

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 And Target.Column = 1 And Target.Row > 2 Then
        If Target = "a" Then Target.ClearContents Else: Target = "a"
        Target.Font.Name = "Marlett"
        Target.Offset(, 1).Activate
    End If
End Sub

(Instead of checking to see if checkbox is ticked, test if value of cell is "a")

 

[CrispyAsian]

@dmt32 I tried your code, but it didn't work. Thanks for trying though.
@Norie I was using Form Controls but they gave me even bigger headaches. Also, I don't want the code to run when the checkbox is marked, but when the code does run I need it to check all the check boxes in comparison to the person's name.
@Yongle What an interesting idea. Very out-of-the-box style. I liked it a lot and decided to use it. I made a couple edits to make the code a little more appealing to look at. Also, I wasn't a huge fan of the Offset so I just took it out. This is what I'm using:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 And Target.Column = 1 And Target.Row > 2 Then
        If Target = ChrW(&H2713) Then
        Target = "X"
        Target.Font.ColorIndex = 3
        Else
        Target = ChrW(&H2713)
        Target.Font.ColorIndex = 10
        Target.HorizontalAlignment = xlHAlignCenter
        End If
    End If
End Sub

I would have never thought of something like that myself. Thanks a lot, it's working perfectly.

 

[My Aswer Is This]

Yes a easier way to do things

 

[Yongle]

Thanks for the feedback - glad the code is useful