Reputation: 35
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
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
Upvotes: 1