I have a userform with multiple dependent Comboboxes. I would like to add the following code to 10 of the Comboboxes Change event. The Comboboxes to be coded are Numbered 11 to 20 (Combobox11, Combobox 12, etc) while the dependent Comboboxes are numbered 21 to 30.
I could copy and paste the code 10 times and then find and replace the relevant Combobox Nos.
Is there a way to use a loop through the Combo-Boxes to achieve this?
Any assistance would be most grateful.
Private Sub ComboBox11_Change()
Dim index As Integer
index = ComboBox11.ListIndex
ComboBox21.Clear
Select Case index
Case Is = 0
With ComboBox21
.RowSource = Range("SubCat1").Address(external:=True)
End With
Case Is = 1
With ComboBox21
.RowSource = Range("SubCat6").Address(external:=True)
End With
Case Is = 2
With ComboBox21
.RowSource = Range("SubCat7").Address(external:=True)
End With
Case Is = 3
With ComboBox21
.RowSource = Range("SubCat8").Address(external:=True)
End With
Case Is = 4
With ComboBox21
.RowSource = Range("SubCat9").Address(external:=True)
End With
'and several more case options
End Select
End Sub
You can use a Class Module, and a User_Init Sub to set each ComboBox control in the user form to this class.
In my code I used Main_Form as the name of the User_Form, modify the code according to your User_Form Name.
Add a Calls Module, and add this code below in Class 1:
Public WithEvents ComboBoxEvents As MSForms.ComboBox
' anytime a Change event occurs to any ComboBox, the Sub is triggered
Private Sub ComboBoxEvents_Change()
Dim ComboBox_Index As String
Dim index As Integer
With ComboBoxEvents
' read the index of the ComboBox, as long as the names remain ComboBox1, ComboBox2, ComboBox3, etc...
ComboBox_Index = Mid(.Name, 9)
' run this code if it's ComboBox 11 to 20
If ComboBox_Index >= 11 And ComboBox_Index <= 20 Then
index = .ListIndex
Select Case index
Case Is = 0
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat1").Address(external:=True)
End With
Case Is = 1
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat6").Address(external:=True)
End With
Case Is = 2
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat7").Address(external:=True)
End With
Case Is = 3
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat8").Address(external:=True)
End With
Case Is = 4
With Main_Form.Controls("ComboBox" & ComboBox_Index + 10)
.RowSource = Range("SubCat9").Address(external:=True)
End With
'and several more case options
End Select
End If
End With
End Sub
The code below goes in your User_Form_Init (in my code the name of the User_Form is Main-Form) :
Option Explicit
Dim ComboBoxes() As New Class1
Private Sub UserForm_Initialize()
Dim ComboBoxCounter As Integer, Obj As Control
For Each Obj In Me.Controls
If TypeOf Obj Is MSForms.ComboBox Then
ComboBoxCounter = ComboBoxCounter + 1
ReDim Preserve ComboBoxes(1 To ComboBoxCounter)
Set ComboBoxes(ComboBoxCounter).ComboBoxEvents = Obj
End If
Next Obj
Set Obj = Nothing
End Sub
the way is using Class
add a Class module and name it after "CmbBox" (you can choose whatever name but be consistent with it)
add the following code into the class code pane:
Option Explicit
Public WithEvents Cmb As MSForms.ComboBox
Private Sub Cmb_Change()
Dim index As Long
With Cmb
index = .ListIndex
With .Parent.Controls("ComboBox" & Mid(.Name, 9) + 10)
.Clear
Select Case index
Case 0
.RowSource = Range("SubCat1").Address(external:=True)
Case 1 To 4
.RowSource = Range("SubCat" & index + 5).Address(external:=True)
End Select
End With
End With
End Sub
Then switch to your userfom code pane and add this code:
Dim Cmbs(1 To 10) As New CmbBox '<--| this must be at the very top of your userform code pane
Sub Userform_Initialize()
Dim i As Long
With Me.Controls
For i = 11 To 20
Set Cmbs(i - 10).Cmb = .Item("ComboBox" & i)
Next i
End With
End Sub
and that's it
Related
I'm making a Userform in VBA where I have Text Box's where I can search items. I have about 30 Text Box's so I want to cut down the code using a loop instead of copy and pasting the same code 30 times.
Problem: I don't know how to loop through a public variable
Public Variable: Public oEventHandler(Number) As New clsSearchableDropdown
oEventHandler would go from 1 to 30 (e.g oEventHandler2,oEventHandler3...oEventHandler30)
clsSearchableDropdown is the Class Module for the search feature
Text Box: TextBox(Number)
ListBox: ListBox(Number)
Here is the original code (No Issue Just to Compare):
With oEventHandler1
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.ListBox1
Set .SearchTextBox = Me.TextBox1
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
This is what I'm trying to do:
Dim i As Integer
for i = 1 to 30
With Me.Controls.Item("oEventHandler" & i)
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.Controls.Item("ListBox" & i)
Set .SearchTextBox = Me.Controls.Item("TextBox" & i)
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
Next i
I know that oEventHandler is not a control but is there a similar code I can use to loop through a public variable?
Here is the code that worked for me:
' Make a New Collection
Dim coll As New Collection
' Add all Public Variables to Collection (n = Number 1 to 30)
coll.Add uQuote.oEventHandler(n)
(e.g oEventHandler1, oEventHandler2... oEventHandler30)
Dim i As Integer
for i = 1 to 30
With coll(i)
' Attach the textbox and listbox to the class
Set .SearchListBox = Me.Controls.Item("ListBox" & i)
Set .SearchTextBox = Me.Controls.Item("TextBox" & i)
' Default settings
.MaxRows = 10
.ShowAllMatches = True
.CompareMethod = vbTextCompare
.WindowsVersion = False
End With
Next i
If I understand you correctly, in the userform you have 30 Textboxes and 30 Listboxes, where each Textbox(N) is to search the value in the Listbox(N) located under that TextBox(N). So it looks something like this :
On the left side is TextBox01, under TextBox01 is ListBox01
On the right side is TextBox02, under TextBox02 is ListBox02
If the animation is similar with your expectation....
Preparation :
Make a named range (as many as needed) with something like List01, List02, List03, and so on for the value to populate each ListBox.
Name each ListBox with something like ListBox01, ListBox02, and so on.
Name each TextBox with something like TextBox01, TextBox02, and so on.
In the Userform module:
Dim MyTextBoxes As Collection
Private Sub UserForm_Initialize()
'populate the ListBoxes with value in a named range
Dim LBname As String: Dim RGname As String: Dim i As Integer
For i = 1 To 2
LBname = "ListBox" & Format(i, "00")
RGname = "List" & Format(i, "00")
Controls(LBname).List = Application.Transpose(Range(RGname))
Next i
'add each TextBox to class
Set MyTextBoxes = New Collection
For Each ctl In Me.Controls
Set TextBoxClass = New Class1
If TypeName(ctl) = "TextBox" And InStr(ctl.Name, "TextBox") Then Set TextBoxClass.obj = ctl
MyTextBoxes.Add TextBoxClass
Next
End Sub
In the Class Module named Class1:
Private WithEvents tb As MSForms.TextBox
Property Set obj(t As MSForms.TextBox)
Set tb = t
End Property
Private Sub tb_Change()
Dim idx As String: Dim LBname As String: Dim arr
idx = Right(tb.Name, 2)
LBname = "ListBox" & idx
arr = Application.Transpose(Range("List" & idx))
With Userform1.Controls(LBname)
If tb.text = "" Then
.Clear
.List = arr
Else
.Clear
For i = LBound(arr, 1) To UBound(arr, 1)
If LCase(arr(i)) Like "*" & LCase(tb.value) & "*" Then .AddItem arr(i)
Next i
End If
End With
End Sub
If in your userform you have another textbox which not to use as a search of the items in respective listbox, then maybe don't name the textbox with "TextBox" but something else, for example "blablabla".
if your existing textbox and listbox already named something like ListBox1, ListBox2, ListBox3 and so on, TextBox1, TextBox2, TextBox3 and so on... then name the named range like List1, List2, List3 and so on. In the class module, change the code for idx using the replace method, something like idx = replace(tb.name,"TextBox",""). Also in the Userform module for LBname and RGname use the replace method.
Because I'm limited in English language, I'm sorry I can't detail the code for further explanation.
So I have a form called "Print_Form" that has 20 checkboxes that upon form initialization take on the sheet names of the first 20 sheets of my workbook.
(no issue with the UserForm_Initialize() sub, this works fine)
Private Sub UserForm_Initialize()
CheckBox1.Caption = Sheets(1).Name
CheckBox2.Caption = Sheets(2).Name
CheckBox3.Caption = Sheets(3).Name
CheckBox4.Caption = Sheets(4).Name
CheckBox5.Caption = Sheets(5).Name
CheckBox6.Caption = Sheets(6).Name
CheckBox7.Caption = Sheets(7).Name
CheckBox8.Caption = Sheets(8).Name
CheckBox9.Caption = Sheets(9).Name
CheckBox10.Caption = Sheets(10).Name
CheckBox11.Caption = Sheets(11).Name
CheckBox12.Caption = Sheets(12).Name
CheckBox13.Caption = Sheets(13).Name
CheckBox14.Caption = Sheets(14).Name
CheckBox15.Caption = Sheets(15).Name
CheckBox16.Caption = Sheets(16).Name
CheckBox17.Caption = Sheets(17).Name
CheckBox18.Caption = Sheets(18).Name
CheckBox19.Caption = Sheets(19).Name
CheckBox20.Caption = Sheets(20).Name
End Sub
Where I am running into issues is in the following sub routine when the user clicks the print button in the form. The intention behind this button is to print all the sheets that the user has selected (i.e. the sheets that had their corresponding checkbox checked by the user). Currently, when I select multiple checkboxes and then click on the print button I get the following error; "Run-Time error '9': Subscript out of range.
Private Sub cmdPrint_Click()
Dim i As Integer
Dim cb As MSForms.Control
Dim SheetArray() As String
i = 0
'Search form for a checkbox
For Each cb In Me.Controls
i = i + 1
ReDim Preserve SheetArray(i)
'If the control is a checkbox
If TypeName(cb) = "CheckBox" Then
'and the checkbox is checked
If cb.Value = True Then
'Add the sheet to the sheet array (sheet name string was already added to the checkbox property caption; see UserForm_initialize)
SheetArray(i) = cb.Caption
End If
End If
Next cb
'Print Sheet Array
Sheets(SheetArray()).PrintOut
Unload Me
End Sub
If anyone has any ideas that would help me get this to work I would be very appreciative. Thank you in advance. :)
Try this:
Private Sub UserForm_Initialize()
Dim i As Long
For i = 1 To 20 'less typing....
Me.Controls("CheckBox" & i).Caption = Sheets(i).Name
Next i
End Sub
Private Sub cmdPrint_Click()
Dim i As Integer, s As String, sep
For i = 1 To 20
With Me.Controls("CheckBox" & i)
If .Value Then
s = s & sep & .Caption
sep = "," 'add delimiter after first item
End If
End With
Next i
Sheets(Split(s, ",")).PrintOut
Unload Me
End Sub
I have a userform where I put 10 rows of comboboxes for 7 columns. Which means I got 70 comboboxes altogether. To ease your understanding, I will refer the first combobox as (1,1) for (row,column).
What am I trying to do is, when a user input values on any combobox on Row 1, I want the values to be copied on its adjacent combobox at Row 2.
For example, if I select value on (1,3), same value will appear on (2,3). The same thing goes to Row 3 & 4, Row 5 & 6, and so on.
This is the code on my class module clsLineCopy:
Public WithEvents myCbo As msForms.ComboBox
Private Sub myCbo_Change()
Dim i As Integer
'MsgBox "Combo Box " & myCbo.Value & " has changed"
If myCbo.Value <> "" Then
myCbo.Copy
myCbo.Paste
End If
End Sub
This one is my code on my userform_initialize:
Dim myCommonCbo As New Collection
Dim cbo As clsLineCopy
For i = 1 To 70
Set cbo = New clsLineCopy
Set cbo.myCbo = Me.Controls("ComboBox" & i)
myCommonCbo.Add Item:=cbo
Next i
Set cbo = Nothing
I know my code in the class module is wrong as I have no idea about it.
Thanks,
Izz.
In my demo I named the Userform -> FormComboGrid
Here are the changes you need:
Userform: Public CallBack method
Userform: Class level boolean variable used to prevent cascading CallBacks
myCommonCbo has to be elevated to a Class Level Variable. This keeps the references valid after the UserForm_Initialize finishes execution.
clsLineCopy should have an Init method used to pass a reference of the Userform instance and the Combobox that is being hooked.
FormComboGrid:Class
Option Explicit
Private myCommonCbo As New Collection
Private ComboBoxEventEnabled As Boolean
Private Sub UserForm_Initialize()
Dim i As Long
Dim cbo As clsLineCopy
For i = 1 To 70
Set cbo = New clsLineCopy
cbo.Init Me, Me.Controls("ComboBox" & i)
myCommonCbo.Add Item:=cbo
' Me.Controls("ComboBox" & i).List = Array(1, 2, 3, 4, 5, 6, 7)
Next i
ComboBoxEventEnabled = True
End Sub
Public Sub ComboboxChange(cbo As MSForms.ComboBox)
If Not ComboBoxEventEnabled Then Exit Sub
ComboBoxEventEnabled = False
Dim index As Long, r As Long, c As Long
Dim myCbo As MSForms.ComboBox
index = Replace(cbo.Name, "ComboBox", "")
c = index Mod 10
r = Int(index / 10) + 1
If r = 7 Then Exit Sub
index = ((r * 10) + c)
Set myCbo = Me.Controls("ComboBox" & index)
myCbo.Value = cbo.Value
ComboBoxEventEnabled = True
End Sub
clsLineCopy:Class
Option Explicit
Private WithEvents myCbo As MSForms.ComboBox
Private mForm As FormComboGrid
Private Sub myCbo_Change()
mForm.ComboboxChange myCbo
End Sub
Public Sub Init(Form As FormComboGrid, cbo As MSForms.ComboBox)
Set mForm = Form
Set myCbo = cbo
End Sub
I'm having a problem assigning VBA generated ActiveX checkboxes to a class module. When a user clicks a button, the goal of what I am trying to achieve is: 1st - delete all the checkboxes on the excel sheet; 2nd - auto generate a bunch of checkboxes; 3rd - assign a class module to these new checkboxes so when the user subsequently clicks one of them, the class module runs.
I've borrowed heavily from previous posts Make vba code work for all boxes
The problem I've having is that the 3rd routine (to assign a class module to the new checkboxes) doesn't work when run subsequently to the first 2 routines. It runs fine if run standalone after the checkboxes have been created. From the best I can tell, it appears VBA isn't "releasing" the checkboxes after they have been created to allow the class module to be assigned.
The below code is the simplified code that demonstrates this problem. In this code, I use a button on "Sheet1" to run Sub RunMyCheckBoxes(). When button 1 is clicked, the class module did not get assigned to the newly generated checkboxes. I use button 2 on "Sheet1" to run Sub RunAfter(). If button 2 is clicked after button 1 has been clicked, the checkboxes will be assigned to the class module. I can't figure out why the class module won't be assigned if just the first button is clicked. Help please.
Module1:
Public mcolEvents As Collection
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Call SetCBAction("Sheet1")
End Sub
Sub DeleteAllCheckboxesOnSheet(SheetName As String)
Dim obj As OLEObject
For Each obj In Sheets(SheetName).OLEObjects
If TypeOf obj.Object Is MSForms.CheckBox Then
obj.Delete
End If
Next
End Sub
Sub InsertCheckBoxes(SheetName As String, CellRow As Double, CellColumn As Double, CBName As String)
Dim CellLeft As Double
Dim CellWidth As Double
Dim CellTop As Double
Dim CellHeight As Double
Dim CellHCenter As Double
Dim CellVCenter As Double
CellLeft = Sheets(SheetName).Cells(CellRow, CellColumn).Left
CellWidth = Sheets(SheetName).Cells(CellRow, CellColumn).Width
CellTop = Sheets(SheetName).Cells(CellRow, CellColumn).Top
CellHeight = Sheets(SheetName).Cells(CellRow, CellColumn).Height
CellHCenter = CellLeft + CellWidth / 2
CellVCenter = CellTop + CellHeight / 2
With Sheets(SheetName).OLEObjects.Add(classtype:="Forms.CheckBox.1", Link:=False, DisplayAsIcon:=False, Left:=CellHCenter - 8, Top:=CellVCenter - 8, Width:=16, Height:=16)
.Name = CBName
.Object.Caption = ""
.Object.BackStyle = 0
.ShapeRange.Fill.Transparency = 1#
End With
End Sub
Sub SetCBAction(SheetName)
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets(SheetName).OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
Sub RunAfter()
Call SetCBAction("Sheet1")
End Sub
Class Module (clsActiveXEvents):
Option Explicit
Public WithEvents mCheckBoxes As MSForms.CheckBox
Private Sub mCheckBoxes_click()
MsgBox "test"
End Sub
UPDATE:
On further research, there is a solution posted in the bottom answer here:
Creating events for checkbox at runtime Excel VBA
Apparently you need to force Excel VBA to run on time now:
Application.OnTime Now ""
Edited lines of code that works to resolve this issue:
Sub RunMyCheckboxes()
Dim i As Double
Call DeleteAllCheckboxesOnSheet("Sheet1")
For i = 1 To 10
Call InsertCheckBoxes("Sheet1", i, 1, "CB" & i & "1")
Call InsertCheckBoxes("Sheet1", i, 2, "CB" & i & "2")
Next
Application.OnTime Now, "SetCBAction" '''This is the line that changed
End Sub
And, with this new formatting:
Sub SetCBAction() ''''no longer passing sheet name with new format
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In Sheets("Sheet1").OLEObjects '''''No longer passing sheet name with new format
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckBoxes = o.Object
mcolEvents.Add cCBEvents
End If
Next
End Sub
If OLE objects suit your needs then I'm glad you've found a solution.
Are you aware, though, that Excel's Checkbox object could make this task considerably simpler ... and faster? Its simplicity lies in the fact that you can easily iterate the Checkboxes collection and that you can access its .OnAction property. It is also easy to identify the 'sender' by exploiting the Evaluate function. It has some formatting functions if you need to tailor its appearance.
If you're after something quick and easy then the sample below will give you an idea of how your entire task could be codified:
Public Sub RunMe()
Const BOX_SIZE As Integer = 16
Dim ws As Worksheet
Dim cell As Range
Dim cbox As CheckBox
Dim i As Integer, j As Integer
Dim boxLeft As Double, boxTop As Double
Set ws = ThisWorkbook.Worksheets("Sheet1")
'Delete checkboxes
For Each cbox In ws.CheckBoxes
cbox.Delete
Next
'Add checkboxes
For i = 1 To 10
For j = 1 To 2
Set cell = ws.Cells(i, j)
With cell
boxLeft = .Width / 2 - BOX_SIZE / 2 + .Left
boxTop = .Height / 2 - BOX_SIZE / 2 + .Top
End With
Set cbox = ws.CheckBoxes.Add(boxLeft, boxTop, BOX_SIZE, BOX_SIZE)
With cbox
.Name = "CB" & i & j
.Caption = ""
.OnAction = "CheckBox_Clicked"
End With
Next
Next
End Sub
Sub CheckBox_Clicked()
Dim sender As CheckBox
Set sender = Evaluate(Application.Caller)
MsgBox sender.Name & " now " & IIf(sender.Value = 1, "Checked", "Unchecked")
End Sub
I have created a form where I am dynamically creating Textboxes and corresponding Comboboxes along with Combobox change event. Here is the class creating combobox event handler
Option Explicit
Public WithEvents cbx As MSforms.Combobox
Private avarSplit As Variant
Sub SetCombobox(ctl As MSforms.Combobox)
Set cbx = ctl
End Sub
Private Sub cbx_Change()
Dim i As Integer
If cbx.ListIndex > -1 Then
'MsgBox "You clicked on " & cbx.Name & vbLf & "The value is " & cbx.Value
avarSplit = Split(cbx.Name, "_")
'DecessionOnValue
End If
End Sub
And here is the code on the form which is dynamically creating textboxes and Comboboxes
Function AddTextBox(Frame1 As frame, numberOfColumns As Integer)
Dim counter As Integer
Dim i As Integer
Dim TxtBox As MSforms.TextBox
For counter = 1 To numberOfColumns
'Forms.CommandButton.1
Set TxtBox = Frame1.Controls.Add("Forms.TextBox.1")
TxtBox.Name = "tb_" + CStr(counter)
'Bouton.Caption = "Test"
TxtBox.Visible = True
i = Property.TextBoxDisable(TxtBox)
' Defining coordinates TextBox height is 18
If counter = 1 Then
TxtBox.Top = 23
Else
TxtBox.Top = (18 * counter) + 5 * counter
End If
TxtBox.Left = 50
Next counter
End Function
Function Combobox(Frame1 As frame, numberOfColumns As Integer)
Dim counter As Integer
Dim i As Integer
Dim CbBox As MSforms.Combobox
Dim cbx As ComboWithEvent
If pComboboxes Is Nothing Then Set pComboboxes = New Collection
For counter = 1 To numberOfColumns
'Forms.CommandButton.1
Set CbBox = Frame1.Controls.Add("Forms.ComboBox.1")
CbBox.Name = "cb_" + CStr(counter)
i = AddComboboxValues(CbBox)
' Defining coordinates TextBox height is 18
If counter = 1 Then
CbBox.Top = 23
Else
CbBox.Top = (18 * counter) + 5 * counter
End If
CbBox.Left = 150
Set cbx = New ComboWithEvent
cbx.SetCombobox CbBox
pComboboxes.Add cbx
Next counter
i = AddScrollBar(Frame1, counter)
End Function
Combobox event handler is working fine but my problem is that I dont know that how can I copy the text of textbox or enable disable the textbox according to the value selected in the dynamic combobox.
Thanks,
Jatin
you'll use this for example :
Me.Controls("ControlName").Visible = True or instead of Visible you can use enable, disable etc..