rRacing9
rRacing9

Reputation: 35

VBA: Remove dynamically added ActiveX-Elements on UserForm (during runtime)

This thread is nearly 4 years old but part of helped me to solve an issue.

What is so far working: in an UserForm, depending on the selection of a ComboBox, a couple of CheckBoxes are created and linked to a custom class (I need a _Click/_Change-Event). Nearly everything works as intented beside one missing feature: deleting CheckBoxes if the selection changes.

During the creation process the CheckBoxes are stored inside a collection

    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name

If the User changes the selected value in the ComboBox a _Change()-event triggers and the re-creation starts (depending on the new selection I might need only one CheckBox or three new ones). The re-creation sub starts by deleting every item of col_Checkbox, then X CheckBoxes will be created and linked to the custom class.

After spending two days looking on how to fix this issue I wanted to post my question here... and now starts the really strange part: I've prepared my question, written down the code in a "copy&paste"-able version in Editor (90% copy&paste, 10% changing some arrays (which need a data source) to some hard numbers) and thought to give it a quick try in a fresh excel sheet (you know, maybe I've forgot to copy some declaration and so on).

After running my code (forgot two global statements.. ups) the whole thing was working as intended to my own surprise. Now I've spend some more time in finding the difference and it looks like I don't find any difference beside the missing array/collection I've switched for some hard numbers.

So, maybe someone can help me to make my real code work just like my "ready-to-post"-code? I'm happy it's working but also baffled how it's working.

The difference: My ComboBox is filled with a couple of strings. Upon picking a string VBA starts to look in column2 for matching cases and load all of colum3 them into an array (the string is my first index). In a second step the array is added to a collection, but only unique strings (second index), duplicates won't be added.

str_ComboBox1_Selected = ComboBox1.Value
'### Array1
Dim i As Long, j As Long

    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i
'### Unique-Collection
On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, a
Next
On Error GoTo 0

With col_Index.Count I know how many CheckBoxes I need. In my "demo" I've skipped this part and added some numeric values (1-6) to the ComboBox1. Afterwards I've changed each instance of col_Index.Count to ComboBox1.Value

This should be the same (for demonstration at least), right? Both work as an upper limit for my "For i ="-Loop. During the creation-process each CheckBox gets its own name which again is my collection (col_Index(i)) vs. just i for a generic name (CheckBox_1; CheckBox_2 vs. CheckBox_NAME1; CheckBox_NAME2).

< My Code >
im i As Long
Dim str_ObjName As String

For i = 1 To col_Index.Count
    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & col_Index(i)
        Debug.Print col_Index(i)

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
Next i

vs 
< My Code without col_Index() and some hard numbers >

Dim i As Long
Dim str_ObjName As String

For i = 1 To UserForm1.ComboBox1.Value

    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & i '*Instead of i here would be (collection)(i) to have a proper name

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name  'The created objectes are stored in a collection for later use
        'Debug.Print col_Checkbox.Item(i).Name   'This part works
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
Next i

Everything else is the same... with the debug.print statements I've tried to check if some names don't match - but nope, all three names are identical (as expected).

My delete-sub is

Dim i As Long
i = 1
Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

In both cases (real & demo) the debug-statements show that the loop is working and counting as expected. obj_Checkbox(i) is showing the same statement as col_Checkbox.Item(1).Name - so after every loop the item is removed from my collection. But in my "real" file all CheckBoxes persist and are added below the previos ones while in my "demo" file all CheckBoxes are deleted after the _Change()-Event is working.

What am I missing or doing in a wrong way?

If someone wants to try the demo-snips, feel free to play around: you just need a fresh excel file with a single worksheet with a command button.

For table1

Option Explicit

Private Sub CommandButton1_Click()
    UserForm1.Show
End Sub

Inside a generic class module (Class1)

Option Explicit

Public WithEvents Class1 As MSForms.CheckBox

Public Sub AssignCheckBox(c As MSForms.CheckBox)
    Set Class1 = c
End Sub

Private Sub Class1_Click()
    Debug.Print Class1.Caption
End Sub

For a generic module (Module1)

Option Explicit

Global Class1COL As New Collection
Global obj_Checkbox() As Object, col_Checkbox As Collection

Sub Create()
Dim i As Long
Dim str_ObjName As String

For i = 1 To UserForm1.ComboBox1.Value

    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & i '*Instead of i here would be (collection)(i) to have a proper name

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name  'The created objectes are stored in a collection for later use
        'Debug.Print col_Checkbox.Item(i).Name   'This part works
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
    Select Case True
        Case i = 1
            With obj_Checkbox(1)
                .Top = UserForm1.ComboBox1.Top + 50
            End With
        Case Else
            With obj_Checkbox(i)
                .Top = obj_Checkbox(i - 1).Top + 40
            End With
    End Select

    With obj_Checkbox(i)
        .Left = UserForm1.ComboBox1.Left
        .Height = 35
        .Width = 100
        .Caption = i
    End With

Next i
    Application.OnTime Now, "NewClass"
End Sub

Sub NewClass()
Dim CheckBox As Class1, c As Control
Dim i As Long

    'Debug.Print "new class"
For i = 1 To col_Checkbox.Count
    Set c = col_Checkbox.Item(i)

    Set CheckBox = New Class1
        CheckBox.AssignCheckBox c

        Class1COL.Add CheckBox
Next i
End Sub

Sub Delete()
Dim i As Long
i = 1
Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

And for a standard userform (UserForm1)

Option Explicit

Sub UserForm_Initialize()
    With UserForm1.ComboBox1
        .AddItem 1
        .AddItem 2
        .AddItem 3
        .AddItem 4
        .AddItem 5
        .AddItem 6
    End With

    With UserForm1
        .Top = Application.Top + 50
        .Left = Application.Left + 100
    End With

    Set col_Checkbox = New Collection

End Sub

Sub ComboBox1_Change()
    Call Module1.Delete
'First every CheckBox on the Form is deleted

'in between an array is created from a list of all search-terms (ComboBox1 doesn't have numbers)//
'// and a unique-only collection is created. With (collection).count I've got the number of CheckBoxes to be created


    Call Module1.Create
'Then X new Boxes will be loaded into the form
End Sub

Just in case someone wants to have a look at my array-to-collection routine (maybe here is already an error inside?) In ComboBox1_Change is called:

Sub ComboBox1_Change()

    Call Modul1.Delete

str_ComboBox1_Selected = ComboBox1.Value

Dim i As Long, j As Long

    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i

On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, a
Next
On Error GoTo 0
'For i = 1 To col_Index.Count
    'Debug.Print col_Index(i)
'Next i

    Call Modul1.Create
End Sub

I'm working right now on a "test sample", therefor all these generic name and not all references / variables are correctly declared... this I'll take care of after my test sample will be integrated into my "masterfile".

Thanks for reading my wall of text!

Upvotes: 1

Views: 116

Answers (1)

Ahmed AU
Ahmed AU

Reputation: 2777

It is a real ordeal to go through the code that you prepared with care to work correctly for posting,(while SO ask for minimal-reproducible code) and gradually replacing working code with your original code. making them work with necessary declaration and makeshift data.

The presumably original code is working correctly with some minor modification. Even after such an ordeal to reproduce the original code, I could not reproduced the deletion error. However I used some makeshift numeric data to work with in column B (with random number 1 to 10) & C (with random numbers) of Sheet1 of the file. After initialization of user form, I had to call ComboBox1_Change() event to populate arr_AllIndex and col_index. So I used a flag to bypass Delete on the first call ComboBox1_Change() . inadvertently I forgot to reset the flag after 1st call. That somehow give me glimpse of what you may be experiencing. The main modification lead to correct working may be the line Set col_Checkbox = New Collection in the Sub Create.

Here is the code working correctly posted with hope that it is closest to the original code and somehow helps you.

In userform1

Option Explicit
Public flag As Boolean
Sub UserForm_Initialize()
    With UserForm1.ComboBox1
        .AddItem 1
        .AddItem 2
        .AddItem 3
        .AddItem 4
        .AddItem 5
        .AddItem 6
        .ListIndex = 2
    End With

    With UserForm1
        .Top = Application.Top + 50
        .Left = Application.Left + 100
    End With

    'Set col_Checkbox = New Collection
    'Set col_Index = New Collection
    flag = False
Call ComboBox1_Change
End Sub
Sub ComboBox1_Change()
If flag Then Call Module1.Delete  'to Bypass delete 1st time after Userform Initialize
flag = True
Dim str_ComboBox1_Selected As Integer
Dim ln_LastRow As Long
Dim Ws As Worksheet, arr_AllIndex() As Variant, a As Variant
str_ComboBox1_Selected = ComboBox1.Value
Set Ws = ThisWorkbook.Sheets("Sheet1")
ln_LastRow = Ws.Cells(Rows.Count, 2).End(xlUp).Row
'Debug.Print str_ComboBox1_Selected


Dim i As Long, j As Long
    For i = 1 To ln_LastRow
        If Cells(i, 2).Value = str_ComboBox1_Selected Then
            ReDim Preserve arr_AllIndex(j)
            arr_AllIndex(j) = Cells(i, 3).Value
            'Debug.Print arr_AllIndex(j)
            j = j + 1
        End If
    Next i

Set col_Index = New Collection
On Error Resume Next
For Each a In arr_AllIndex
    col_Index.Add a, CStr(a)
Next
On Error GoTo 0

'For i = 1 To col_Index.Count
'    Debug.Print "Col Index:" & col_Index(i)
'Next i

 Call Module1.Create
 End Sub 

In Module1

Option Explicit
Global Class1COL As New Collection
Global obj_Checkbox() As Object, col_Checkbox As Collection, col_Index As Collection
Sub Create()
Dim i As Long
Dim str_ObjName As String

Set col_Checkbox = New Collection
For i = 1 To col_Index.Count
    ReDim Preserve obj_Checkbox(i)

    str_ObjName = "Checkbox_" & col_Index(i)
        'Debug.Print col_Index(i)

    Set obj_Checkbox(i) = UserForm1.Controls.Add("Forms.CheckBox.1", str_ObjName)
    col_Checkbox.Add obj_Checkbox(i), obj_Checkbox(i).Name
            'Debug.Print str_ObjName
            'Debug.Print obj_Checkbox(i).Name
            'Debug.Print col_Checkbox.Item(i).Name
     Select Case True
        Case i = 1
            With obj_Checkbox(1)
                .Top = UserForm1.ComboBox1.Top + 50
            End With
        Case Else
            With obj_Checkbox(i)
                .Top = obj_Checkbox(i - 1).Top + 40
            End With
    End Select

    With obj_Checkbox(i)
        .Left = UserForm1.ComboBox1.Left
        .Height = 35
        .Width = 100
        .Caption = str_ObjName
    End With

Next i
NewClass
End Sub
Sub NewClass()
Dim CheckBox As Class1, c As Control
Dim i As Long

    'Debug.Print "new class"
For i = 1 To col_Checkbox.Count
    Set c = col_Checkbox.Item(i)

    Set CheckBox = New Class1
        CheckBox.AssignCheckBox c

        Class1COL.Add CheckBox
Next i
End Sub
Sub Delete()
Dim i As Long
i = 1

Do While col_Checkbox.Count > 0
        'Debug.Print obj_Checkbox(i).Name
        'Debug.Print col_Checkbox.Item(1).Name
    UserForm1.Controls.Remove col_Checkbox.Item(1).Name
        'Debug.Print "i=" & i
    col_Checkbox.Remove 1
    i = i + 1
Loop

End Sub

Class module was unchanged. May please feedback

Result Image

Upvotes: 1

Related Questions