Setting a VBA form object using a string - vba

Hello,
I am trying to set up a form which is a calendar from which the user can select a date (by default the current month appears). The form consists of 42 command buttons (I have left the default name ie. CommandButton1) which I am setting the day number.
At the moment I have a long-winded section of code for each button (I used Excel to generate this rather than type it all out) which locks and hides the button if it is outside of the month in question which looks like this:
NewDate.CommandButton1.Caption = Format(DATlngFirstMonth - DATintDayNumFirst + DATintX, "dd")
If DATintX < DATintDayNumFirst Then
With NewDate.CommandButton1
.Locked = True
.Visible = DATbooShowExtraDays
.ForeColor = RGB(150, 150, 150)
End With
Else
With NewDate.CommandButton1
.Locked = False
.Visible = True
.ForeColor = RGB(0, 0, 0)
End With
End If
I know that I can refer to a command button by:
Dim objCommandButton As Object
Set objCommandButton = NewDate.CommandButton1
..which neatens the code up somewhat. But what I would like to do is refer to the command button as a string so I can loop through all 42, ie.
Dim n as integer
n = 1
Do Until n > 42
Set objCommandButton = NewDate.CommandButton & n
'Some operations
n = n + 1
Loop
Many thanks in advance for assistance.

You can loop through all controls of the form. Try
Sub LoopButtons()
Dim it As Object
For Each it In NewDate.Controls
Debug.Print it.Name
Next it
End Sub
Then you can put conditional expression (if ... then) in place of Debug.Print or whatever. For example
If Instr(it.Name, "CommandButton") Then
'do your code
end if

Here's code which iterates over ActiveX controls on active sheet:
Sub IterateOverActiveXControlsByName()
Dim x As Integer
Dim oleObjs As OLEObjects
Dim ctrl As MSForms.CommandButton
Set oleObjs = ActiveSheet.OLEObjects
For x = 1 To 10
Set ctrl = oleObjs("CommandButton" & x).Object
Next
End Sub

Related

Looping through Control Names and hiding all controls that contain the right number within a frame

What I am trying to do is on a Word Userform, if I select a number in a combo box (cb_CountCohorts) (options are 1-10) then any control (option button or textbox that contains that number +1 (so if I select 5, those controls that have 6-10) will not be visible.
With that being said, I did get it to work but I know that it is not efficient.
Below is the beginning but I realize for each case, there would have to be 10 more sets of what you see below times 10 different If statements. Is there a way to say something like if cb_Countcohrts ="1" find all controls in this frame that does not contain Cohort 1 and hide it...if cb_countcohorts ="5" then hide everything that contains cohort 6, 7, 8, 9, 10? Thanks in advance for all and any help
Private Sub cb_CountCohorts_Change()
If cb_CountCohorts = "1" Then
txt_cohort1.Visible = True
txt_cohort2.Visible = False
txt_cohort3.Visible = False
txt_cohort4.Visible = False
txt_cohort5.Visible = False
txt_cohort6.Visible = False
txt_cohort7.Visible = False
txt_cohort8.Visible = False
txt_cohort9.Visible = False
txt_cohort10.Visible = False
I tried this too but it doesnt seem to work like I want either
Private Sub cb_CountCohorts_Change()
For i = 2 To 10
Set VarText = frm_master.Controls("txt_cohort" & i)
If cb_CountCohorts.Value > VarText.Value Then
VarText.Visible = False
End If
Next i
End Sub
Something like this:
Private Sub cb_CountCohorts_Change()
Dim v As Long, i As Long
v = CLng(cb_CountCohorts.Value)
For i = 2 To 10
Me.Controls("txt_cohort" & i).Visible = (i <= v)
'any other controls here....
Next i
End Sub
If you want something generic for all controls (assuming a consistent naming convention) -
Private Sub cb_CountCohorts_Change()
Dim v As Long, c, i As Long, arr
v = CLng(cb_CountCohorts.Value)
For Each c In Me.Controls
If c.Name Like "txt_cohort#*" Then
arr = Split(c.Name, "_")
i = CLng(Replace(arr(1), "txt_cohort", ""))
c.Visible = (i <= v)
End If
Next c
End Sub
...basically expanded from Robert's suggestion
Untested, but this should work:
Dim c As Control
For Each c In Me.Controls
If InStr(TypeName(c),"cohort") Then
c.Visible = False
End If
Next

How to check if userform checkboxes were checked or not; which were dynamically created?

I have a userform with dynamic checkboxes(programmed)
Below is my code
Dim Rows As Integer
Dim toppart As Integer
Dim Opt As Variant
Dim x As Integer
On Error Resume Next
toppart = 20
UpdateRow = Application.WorksheetFunction.CountA(ActiveSheet.Range("C3:CU3"))
For x = 3 To UpdateRow
Set Opt = Te.Controls.Add("Forms.CheckBox.1", "CheckBox" & x, True)
Opt.Caption = ActiveSheet.Cells(x, "C").Value
Opt.Width = 70
Opt.Height = 18
Opt.Left = 18
Opt.Top = toppart
toppart = toppart + 20
Next
I know if the checkboxes were set via the controls my code will look something like this:
If (CheckBox1.Value = False) Or (CheckBox2.Value = False) Then
MsgBox "You must select alteast 2 checkboxes", vbCritical
But when the checkboxes are dynamically created I can't think of a efficient way to do it. Please any suggestions or Help is very much appreciated, thanks.
Untested, but you can probably loop the controls on your form, check if each is a checkbox, if it is, query it's .Value and tally the total number of checkboxes which are "checked. If that number is LTE 1, then you raise your warning/MsgBox:
Dim checked as Long
Dim ctrl as Object
For Each ctrl in Me.Controls
If TypeName(ctrl) = "CheckBox" Then
If ctrl.Value = True Then
checked = checked + 1
End If
End If
Next
If checked <= 1 Then
MsgBox "You must select alteast 2 checkboxes", vbCritical
Exit Sub
End If

'Object Required' error when referencing dynamically created controls, stored in a collection, in the class of another dynamically created control

I am using a spin button to cycle through dates of a phase. When I call an item from a collection called customtextboxcollection with its index value, I get an "Object Required" error. Both the spin button and the text box whose value changes are dynamically created controls displayed on a UserForm called UserForm1.
The sub to create the items in customtextbox collection run before the spin button is clicked:
Dim customtextboxcollection As Collection
Dim spinbuttoncollection As Collection
Public Sub ComboBox1_Click() 'When a person is selected to enter hours for an employee from a combobox, it triggers the creation of the controls
Sheet1.Activate
CommandButton1.Enabled = True 'Enable the OK and Apply buttons when personnel title is selected.
UserForm1.Label2.Visible = True
UserForm1.ratebox.Visible = True
QuantityLabel.Visible = True
quantitybox.Visible = True
'The variables below are to access the table where I store saved information regarding the project phases I will add hours to.
Dim counter As Integer
counter = 6 'The index of the first row for phases
Dim phasecolumn As Integer
phasecolumn = 3 'The index of the column containing the phases
Dim checkboxnumber As Integer
checkboxnumber = 1 'This is the number needed to distinguish between the checkboxes that appear/disappear.
phasestartcolumn = 4
phaseendcolumn = 5
Dim customtextboxHandler As cCustomTextBoxHandler
Set customtextboxcollection = New Collection 'Sets the previously created collection
Dim spinbuttonHandler As cSpinButtonHandler 'This is my spin button handler class
Set spinbuttoncollection = New Collection 'Sets the previously created collection
'This Do-Loop locates a row on the table with saved information
Do
If (Sheet3.Cells(savedpersonnelrow, savedpersonnelcolumn) = ComboBox1.Value) Then
storagerow = savedpersonnelrow
lastcomboboxvalue = ComboBox1.Value
Exit Do
End If
savedpersonnelrow = savedpersonnelrow + 1
Loop Until (savedpersonnelrow = 82)
Sheet1.Activate
'These sections create the controls depending on the number of phases saved.
Set spin = UserForm1.Controls.Add("Forms.SpinButton.1")
With spin
.name = "SpinButton" & checkboxnumber
.Left = 365
.Top = topvalue + 6
.Height = 15
.Width = 40
'.Value = Sheet3.Cells(storagerow, savedphasecolumn + checkboxnumber)
'Sheet1.Activate
Dim phasestart As Date
phasestart = Sheet1.Cells(counter, phasestartcolumn).Value
Dim phaseend As Date
phaseend = Sheet1.Cells(counter, phaseendcolumn).Value
spin.Min = phasestart
spin.Max = phaseend
spin.Orientation = fmOrientationVertical
'Do
'.AddItem Format(phasestart, "mmm-yy")
'phasestart = DateAdd("m", 1, phasestart)
'Loop Until (Month(phaseend) = Month(phasestart) And Year(phaseend) = Year(phasestart))
Set spinbuttonHandler = New cSpinButtonHandler
Set spinbuttonHandler.spin = spin
spinbuttoncollection.Add spinbuttonHandler
End With
Set ctext = UserForm1.Controls.Add("Forms.TextBox.1")
With ctext
.name = "CustomTextbox" & checkboxnumber
.Left = 470
.Top = topvalue + 6
.Height = 15
.Width = 40
.Value = phasestart
Set customtextboxHandler = New cCustomTextBoxHandler
Set customtextboxHandler.ctext = ctext
customtextboxcollection.Add customtextboxHandler
End With
topvalue = topvalue + 15
counter = counter + 1
checkboxnumber = checkboxnumber + 1
Loop Until counter = 14
End Sub
In my class called cSpinButtonHandler, I reference these customtextboxcollection object associated with it's corresponding spin button:
Public WithEvents spin As MSForms.SpinButton
Private Sub spin_Click()
UserForm1.CommandButton3.Enabled = True
End Sub
Private Sub spin_SpinDown()
x = 0
Do
x = x + 1
Loop Until spin.name = "SpinButton" & x
Dim spindate As Date
spindate = customtextboxcollection.Item(x).ctext.Value 'The error occurs here.
customtextboxcollection.Item(x).ctext.Value = DateAdd("m", -1, spindate)
End Sub
Why is this reference generating an error? What is the correct way to reference it?
This is not an answer to your real question, but a suggestion for an alternate approach which might be easier to manage.
Instead of using two separate collections and two different classes, you could create a single class which would handle each pair of controls (one spin and one text box). That would be easier to handle in terms of hooking events between each pair.
clsSpinText:
Option Explicit
Public WithEvents txtbox As MSForms.TextBox
Public WithEvents spinbutn As MSForms.SpinButton
Private Sub spinbutn_Change()
'here you can refer directly to "txtbox"
End Sub
Private Sub txtbox_Change()
'here you can refer directly to "spinbutn"
End Sub
When adding your controls create one instance of clsSpinText per pair, and hold those instances in a single collection.

looping through worksheet command buttons and change visibility

I'm trying to write a code to make a number of buttons visible depending on a cell value
I have 10 command buttons all are invisible and I want to show only the first x
x is the value of cell "A1" in "Sheet1" (will be from 1 to 10)
Command buttons names are default names (CommandButton4, CommandButton5, ... , CommandButton13)
Note: I'm working with a worksheet not a userform
This is my code but i need something shorter and more pro and efficient
Private Sub CommandButton15_Click()
Dim i As Long
Dim CommandButton() As Variant
Application.ScreenUpdating = False
CommandButton = Array("CommandButton4", "CommandButton5", "CommandButton6", "CommandButton7", "CommandButton8", "CommandButton9", "CommandButton10", "CommandButton11", "CommandButton12", "CommandButton13")
For i = LBound(CommandButton) To LBound(CommandButton) + Sheet1.Range("A1").Value - 1
Sheet1.Shapes(CommandButton(i)).Visible = True
Next i
Application.ScreenUpdating = True
End Sub
Need ur help plz
As said in the comment you should rename your buttons. That just makes things easier.
You could for example name them "btn1", "btn2", "btn3" ....
Your code is ok and i can't see major errors. I don't know if you want to add new buttons later.
If so i would recommend something more generic. If you rename the buttons to "btn1"... then you could use something like this:
Private Sub CommandButton15_Click()
Dim btn As OLEObject, name As String, i As Long
i = Sheets(1).Range("A1").Value + 1
For Each btn In ActiveSheet.OLEObjects
name = btn.name
If btn.OLEType = xlButtonOnly And InStr(name, "btn") = 1 Then
If Int(Right(name, Len(name) - 3)) < i Then
btn.Visible = True
Else
btn.Visible = False
End If
End If
Next
End Sub
So you can add new buttons name them with the "btn.." pattern and you don't have to change your Code.

Excel 2010: how to use autocomplete in validation list

I'm using a large validation list on which a couple of vlookup() functions depend. This list is getting larger and larger. Is there a way to type the first letters of the list item I'm looking for, instead of manually scrolling down the list searching for the item?
I've done some Googling but this suggests that this is indeed possible in earlier versions of Excel, but not in Excel 2010. Hope you guys can help.
Here is a very good way to handle this (found on ozgrid):
Let's say your list is on Sheet2 and you wish to use the Validation List with AutoComplete on Sheet1.
On Sheet1 A1 Enter =Sheet2!A1 and copy down including as many spare rows as needed (say 300 rows total). Hide these rows and use this formula in the Refers to: for a dynamic named range called MyList:
=OFFSET(Sheet1!$A$1,0,0,MATCH("*",Sheet1!$A$1:$A$300,-1),1)
Now in the cell immediately below the last hidden row use Data Validation and for the List Source use =MyList
[EDIT] Adapted version for Excel 2007+ (couldn't test on 2010 though but AFAIK, there is nothing really specific to a version).
Let's say your data source is on Sheet2!A1:A300 and let's assume your validation list (aka autocomplete) is on cell Sheet1!A1.
Create a dynamic named range MyList that will depend on the value of the cell where you put the validation
=OFFSET(Sheet2!$A$1,MATCH(Sheet1!$A$1&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))
Add the validation list on cell Sheet1!A1 that will refert to the list =MyList
Caveats
This is not a real autocomplete as you have to type first and then click on the validation arrow : the list will then begin at the first matching element of your list
The list will go till the end of your data. If you want to be more precise (keep in the list only the matching elements), you can change the COUNTA with a SUMLPRODUCT that will calculate the number of matching elements
Your source list must be sorted
Here's another option. It works by putting an ActiveX ComboBox on top of the cell with validation enabled, and then providing autocomplete in the ComboBox instead.
Option Explicit
' Autocomplete - replacing validation lists with ActiveX ComboBox
'
' Usage:
' 1. Copy this code into a module named m_autocomplete
' 2. Go to Tools / References and make sure "Microsoft Forms 2.0 Object Library" is checked
' 3. Copy and paste the following code to the worksheet where you want autocomplete
' ------------------------------------------------------------------------------------------------------
' - autocomplete
' Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' m_autocomplete.SelectionChangeHandler Target
' End Sub
' Private Sub AutoComplete_Combo_KeyDown(ByVal KeyCode As msforms.ReturnInteger, ByVal Shift As Integer)
' m_autocomplete.KeyDownHandler KeyCode, Shift
' End Sub
' Private Sub AutoComplete_Combo_Click()
' m_autocomplete.AutoComplete_Combo_Click
' End Sub
' ------------------------------------------------------------------------------------------------------
' When the combobox is clicked, it should dropdown (expand)
Public Sub AutoComplete_Combo_Click()
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
If cbo.Visible Then cb.DropDown
End Sub
' Make it easier to navigate between cells
Public Sub KeyDownHandler(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Const UP As Integer = -1
Const DOWN As Integer = 1
Const K_TAB_______ As Integer = 9
Const K_ENTER_____ As Integer = 13
Const K_ARROW_UP__ As Integer = 38
Const K_ARROW_DOWN As Integer = 40
Dim direction As Integer: direction = 0
If Shift = 0 And KeyCode = K_TAB_______ Then direction = DOWN
If Shift = 0 And KeyCode = K_ENTER_____ Then direction = DOWN
If Shift = 1 And KeyCode = K_TAB_______ Then direction = UP
If Shift = 1 And KeyCode = K_ENTER_____ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_UP__ Then direction = UP
If Shift = 1 And KeyCode = K_ARROW_DOWN Then direction = DOWN
If direction <> 0 Then ActiveCell.Offset(direction, 0).Activate
AutoComplete_Combo_Click
End Sub
Public Sub SelectionChangeHandler(ByVal Target As Range)
On Error GoTo errHandler
Dim ws As Worksheet: Set ws = ActiveSheet
Dim cbo As OLEObject: Set cbo = GetComboBoxObject(ws)
Dim cb As ComboBox: Set cb = cbo.Object
' Try to hide the ComboBox. This might be buggy...
If cbo.Visible Then
cbo.Left = 10
cbo.Top = 10
cbo.ListFillRange = ""
cbo.LinkedCell = ""
cbo.Visible = False
Application.ScreenUpdating = True
ActiveSheet.Calculate
ActiveWindow.SmallScroll
Application.WindowState = Application.WindowState
DoEvents
End If
If Not HasValidationList(Target) Then GoTo ex
Application.EnableEvents = False
' TODO: the code below is a little fragile
Dim lfr As String
lfr = Mid(Target.Validation.Formula1, 2)
lfr = Replace(lfr, "INDIREKTE", "") ' norwegian
lfr = Replace(lfr, "INDIRECT", "") ' english
lfr = Replace(lfr, """", "")
lfr = Application.Range(lfr).Address(External:=True)
cbo.ListFillRange = lfr
cbo.Visible = True
cbo.Left = Target.Left
cbo.Top = Target.Top
cbo.Height = Target.Height + 5
cbo.Width = Target.Width + 15
cbo.LinkedCell = Target.Address(External:=True)
cbo.Activate
cb.SelStart = 0
cb.SelLength = cb.TextLength
cb.DropDown
GoTo ex
errHandler:
Debug.Print "Error"
Debug.Print Err.Number
Debug.Print Err.Description
ex:
Application.EnableEvents = True
End Sub
' Does the cell have a validation list?
Function HasValidationList(Cell As Range) As Boolean
HasValidationList = False
On Error GoTo ex
If Cell.Validation.Type = xlValidateList Then HasValidationList = True
ex:
End Function
' Retrieve or create the ComboBox
Function GetComboBoxObject(ws As Worksheet) As OLEObject
Dim cbo As OLEObject
On Error Resume Next
Set cbo = ws.OLEObjects("AutoComplete_Combo")
On Error GoTo 0
If cbo Is Nothing Then
'Dim EnableSelection As Integer: EnableSelection = ws.EnableSelection
Dim ProtectContents As Boolean: ProtectContents = ws.ProtectContents
Debug.Print "Lager AutoComplete_Combo"
If ProtectContents Then ws.Unprotect
Set cbo = ws.OLEObjects.Add(ClassType:="Forms.ComboBox.1", Link:=False, DisplayAsIcon:=False, _
Left:=50, Top:=18.75, Width:=129, Height:=18.75)
cbo.name = "AutoComplete_Combo"
cbo.Object.MatchRequired = True
cbo.Object.ListRows = 12
If ProtectContents Then ws.Protect
End If
Set GetComboBoxObject = cbo
End Function
Building on the answer of JMax, use this formula for the dynamic named range to make the solution work for multiple rows:
=OFFSET(Sheet2!$A$1,MATCH(INDIRECT("Sheet1!"&ADDRESS(ROW(),COLUMN(),4))&"*",Sheet2!$A$1:$A$300,0)-1,0,COUNTA(Sheet2!$A:$A))
Excel automatically does this whenever you have a vertical column of items. If you select the blank cell below (or above) the column and start typing, it does autocomplete based on everything in the column.
As other people suggested, you need to use a combobox. However, most tutorials show you how to set up just one combobox and the process is quite tedious.
As I faced this problem before when entering a large amount of data from a list, I can suggest you use this autocomplete add-in . It helps you create the combobox on any cells you select and you can define a list to appear in the dropdown.
=OFFSET(NameList!$A$2:$A$200,MATCH(INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*",NameList!$A$2:$A$200,0)-1,0,COUNTIF($A$2:$A$200,INDIRECT("FillData!"&ADDRESS(ROW(),COLUMN(),4))&"*"),1)
Create sheet name as Namelist. In column A fill list of data.
Create another sheet name as FillData for making data validation list as you want.
Type first alphabet and select, drop down menu will appear depend on you type.