Assigning a dynamically created ActiveX Control to a class

[Swetz]

So I'm dynamically adding a series of ActiveX checkboxes to a worksheet. Each checkbox represents a given product and the set of products varies based on the market I select in a combo box drop down. I have a class module that should control what happens on the click event for each newly added checkbox. I'm having issues assigning the checkboxes to the class.

Here is the class module, which works fine once I get all the checkboxes assigned to the class.

Public WithEvents CBDrugGroup As MSForms.CheckBox
 
Private Sub CBDrugGroup_Click()
With Worksheets("ProductGraph")
Call UpdateDrugGraph(.cbMarket.Value, CBDrugGroup.Caption, .ChartObjects("DrugGraph").Chart, CBDrugGroup.Value, True)
End With
End Sub

Here is the code on the worksheet

Option Explicit
'Create a collection of controls that follow my new class for updating the state graph.
Dim drugcb() As New cbDrugGraph
 
Sub CreateCheckboxes(ByVal Market As String)
'Creates a series of checkboxes per market on the worksheet
    Dim ToRow As Long, LastRow As Long, MyLeft As Double, MyTop As Double, MyHeight As Double, MyWidth As Double
    Dim cb As OLEObject, marketRange As Range, FirstRow As Long, RowCount As Long, ProdListData As Variant, col As Integer
    Dim counter As Long
 
    'Determine how many products are in a given market
    With Worksheets("ProdList")
 
        FirstRow = Application.Match(Market, .Range("A:A"), 0)
        RowCount = Application.WorksheetFunction.CountIf(.Range("A:A"), Market)
 
        Set marketRange = .Range("A1").Offset(FirstRow - 1, 0).Resize(RowCount, 2)
 
        ProdListData = marketRange.Value
 
        Set marketRange = Nothing
 
    End With
 
    'We will only display checkboxes in the first 2 columns, so if there are a lot of products, it will go far down the page
 
    LastRow = UBound(ProdListData, 1) / 2
 
    counter = 0
 
    'Clear the old array of controls
    ReDim drugcb(1 To 1)
 
    For col = 1 To 2
        For ToRow = 5 To LastRow + 5
        counter = counter + 1
 
        If counter > UBound(ProdListData, 1) Then Exit For
        'Get the position from the cells
            MyLeft = Cells(ToRow, col).Left
            MyTop = Cells(ToRow, col).Top
            MyHeight = Cells(ToRow, col).Height
            MyWidth = MyHeight = Cells(ToRow, col).Width + 50
 
            Set cb = ActiveSheet.OLEObjects.Add(classtype:="Forms.Checkbox.1", _
                    Top:=MyTop, Left:=MyLeft, _
                    Height:=MyHeight, Width:=MyWidth)
 
            With cb.Object
                .Caption = ProdListData(counter, 2)
                .Value = False
            End With
 
            'Add the new checkbox to the array assigned to my class
            ReDim Preserve drugcb(1 To counter)
 
            Set drugcb(counter).CBDrugGroup = cb.Object
 
            Set cb = Nothing
 
            Next ToRow
        Next col
 
 
End Sub

This routine then gets called as part of the change event for the market drop down list. Everything works fine, except nothing gets added to the drugcb array. If I split out the code as a separate routine (as below) and run it after the checkboxes are created, everything works fine.

Sub AddtoClass()
'Adds the existing checkboxes to my custom class
Dim boxcount As Integer
Dim oleObj As OLEObject
boxcount = 0
'Clear the old one
ReDim drugcb(1 To 1)
For Each oleObj In OLEObjects
    If oleObj.progID = "Forms.CheckBox.1" Then
            boxcount = boxcount + 1
 
            ReDim Preserve drugcb(1 To boxcount)
 
            Set drugcb(boxcount).CBDrugGroup = oleObj.Object
        End If
    Next oleObj
End Sub

I've tried both calling the "AddToClass" routine in the change event of the market drop down and adding the checkboxes to the array as they are created (as shown above). In either case, my array comes up empty. Since the "AddToClass" routine works just fine when I run it manually after everything is created, my guess is that I'm screwing up either how the checkboxes are assigned to the array or misunderstand the timing of how the checkboxes are added and when I may start referencing them.

Any help would be greatly appreciated.

Thanks,

Swetz

 

[MickG]

I first added the Checkboxes as a One off code then I ran "Addtoclass" as a seperate bit of code.
I imagine if you attach it to the first code, each time the code was run you would get an ever increasing number of Boxes.
Anyway, as you said, run seperately it filled the array and the Class Module functioned, but when I tried it as a seperate Basic Module, Called from the sheet it did not work.
I eventually got it to work by amending the code, as below.
The deciding factor seemed to be removing the declaring of Array "drugcb" as dim drugcb() and assiging as below.
Not to sure why all this happened, but it now works for me.

Option Explicit
Dim drugcb() As cbDrugGraph
Sub AddtoClass()
'Adds the existing checkboxes to my custom class
Dim boxcount As Integer
Dim oleobj As OLEObject
boxcount = 0
ReDim drugcb(1 To ActiveSheet.OLEObjects.Count)
For Each oleobj In ActiveSheet.OLEObjects
    If oleobj.progID = "Forms.CheckBox.1" Then
         boxcount = boxcount + 1
         Set drugcb(boxcount) = New cbDrugGraph
         Set drugcb(boxcount).CBDrugGroup = oleobj.Object
    End If
Next oleobj
ReDim Preserve drugcb(1 To boxcount)
End Sub

Regards Mick

 

[Swetz]

Thank you, but unfortunately that still didn't work for me. The routine behaved the same way as before. The code below for my change event does not populate the array of checkboxes. There are no errors raised. If I manually execute the "AddtoClass" routine directly after this routine runs, it works. I'm still hypothesizing its an issue with dynamically creating the checkboxes and then trying to add them to the array. Once they already exist, the program works just fine.

Private Sub cbMarket_Change()
Application.ScreenUpdating = False

'Delete existing checkboxes
Call DeleteCheckboxes

'Then populate with the new checkboxes
Call CreateCheckboxes(cbMarket.Value)
 
'Add them to our custom class - Does not work for some reason
Call AddtoClass
Application.ScreenUpdating = True
End Sub

 

[MickG]

Like you I could not get it to work within the change event.
My only solution (Not Pretty) was as below to use a "Selection change " event to load the array, after the checkboxes are on the sheet.

I got the "Change event" to change "A2" to "0" and the "Selection change" Event to run the Code "AddtoClass" and change "A2" back to 1 so the code only runs once per, "Worksheet Change" Event.
Perhaps you will be able to use the below in some way.

Private Sub Worksheet_Change(ByVal Target As Range)
'Private Sub cbMarket_Change()
If Target.Address(0, 0) = "A1" Then
Application.ScreenUpdating = False
[a2] = 0
'Delete existing checkboxes
Call DeleteCheckboxes
'Then populate with the new checkboxes
Call CreateCheckboxes 'cbMarket.value)
'Add them to our custom class - Does not work for some reason
 'AddtoClass
Application.ScreenUpdating = True
End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(Target, Range("A1:A2")) Is Nothing Then
    If [a2] = 0 Then
        Call AddtoClass
        [a2] = 1
     End If
End If
End Sub

Regards Mick

 

[RoryA]

Adding ActiveX controls to the worksheet then forces a reset of the project, so your variables go out of scope. If you call the AddToClass routine at the end using Application.Ontime you should be fine. Or just don't use ActiveX controls - use Forms ones instead.

 

[MickG]

Rory
I've been half the morning scratching my head, and then this:-
Application.OnTime Now + TimeValue("00:00:05"), "AddtoClass"
Works a treat !!
I'd already tried "Wait", so close yet so Far.
Regards Mick

 

[RoryA]

 

[shg]

Seems to me that Marlett checkboxes would be simpler to mechanize, with the particular advantage of being on the data layer of the sheet.

 

[Swetz]

That works awesomely. Thank you!!!!