I created a userform with a multipage. On one of the multipages I have a combination of TextBoxes and ComboBoxes. There are a total of 9 Boxes next to each other. They are all control sourced to the excel sheet behind it. When a user enters data into the the first box, it dynamically creates another 9 boxes which correspond to the next row. This process repeats. Now, the 9th box is a TextBox which the visibility is set to false. The 8th box is a ComboBox. If the value in the 8th box is "Existing" Then the visibility of the 9th Box is True.
This is how I'm dynamically created the additional TextBoxes/ComboBoxes:
Private Sub Worksheet_Change(ByVal Target As Range)
Select Case Left(Target.Address, 2)
Case Is = "$A"
Dim cCntrl As Control
Dim i As Integer
For i = 0 To 8
//skipping to case 7 and 8
Case Is = 7
Set cCntrl = UserForm1.Frame13.Controls.Add("Forms.ComboBox.1", "Login" & i & Target.Row + 1, True)
With cCntrl
.Width = UserForm1.ComboBox240.Width
.Height = UserForm1.ComboBox240.Height
.Top = (10 + UserForm1.ComboBox240.Height) * (Target.Row - 1)
.Left = UserForm1.ComboBox240.Left
.ControlSource = "'Multi Branch'!" & Chr(65 + i) & Target.Row + 1
.List = Worksheets("Setup").Range("BILLING").Value
.Style = fmStyleDropDownList
End With
Case Is = 8
Set cCntrl = UserForm1.Frame13.Controls.Add("Forms.TextBox.1", "Login" & i & Target.Row + 1, True)
With cCntrl
.Width = UserForm1.TextBox287.Width
.Height = UserForm1.TextBox287.Height
.Top = (10 + UserForm1.TextBox287.Height) * (Target.Row - 1)
.Left = UserForm1.TextBox287.Left
.ControlSource = "'Multi Branch'!" & Chr(65 + i) & Target.Row + 1
.Name = "BTwo" & (Target.Row - 1)
.Visible = False
End With
End Select
Next
Here is how I am currently changing the visibility:
Case Is = "$H"
If Target.Value = "Existing" Then
UserForm1.Controls("BTwo" & Target.Row - 2).Visible = True
Else
If Target.Row = 2 Then Exit Sub
UserForm1.Controls("BTwo" & Target.Row - 2).Visible = False
End If
End Select
This method technically works, but only after I leave the 8th box. This seems like an OnExit sort of move. The first row i simply did an onchange event which works fine. Any thoughts as to how I can change the visibility on change WITHOUT having to select another box?
Related
All,
I have the below code which creates a dynamic userform based on a list located in an excel worksheet. (Please see picture below)
When the user selects submit I would like to extract all the answers from the user form into an excel file.
Does anyone know how I would do this as I have hit a brick wall in thoughts, the user form to my knowledge has to be built via vba as the list of Project ID & UR can vary from 1 line to thousands of lines.
Any help would be much appreciated.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim labelCounter As Long
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = UserForm6.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
With UserForm6
.Width = 340
.Height = buttonheight + 90
End With
Set CommandApp = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandApp
.Caption = "Submit"
.Left = 10
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
Set CommandCan = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandCan
.Caption = "Cancel"
.Left = 170
.Width = 140
.Font.Size = 10
.Top = buttonheight + 30
End With
End Sub
You will need create variables to hold references to the newly created CommandButtons. By adding the WithEvents modifier you will be able to receive the CommandButton events.
Naming the controls after cell values is problematic. A better solution is to use the MSForms Control Tag property to hold your references. In my example below I add a qualified reference to the target cell.
Changed the subroutines name from addLabel to something more meaningful Show_UserForm6.
Combobox values as they are added.
Userform6 Module
Option Explicit
Public WithEvents CommandApp As MSForms.CommandButton
Public WithEvents CommandCan As MSForms.CommandButton
Private Sub CommandApp_Click()
Dim ctrl As MSForms.Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then
Range(ctrl.Tag).Value = ctrl.Value
End If
Next
End Sub
Private Sub CommandCan_Click()
Unload Me
End Sub
Refactored Code
Sub Show_UserForm6()
Const PaddingTop = 34, Left1 = 10, Left2 = 90, Left3 = 190
Dim c As Range
Dim Top As Single
Top = 34
With UserForm6
.Show vbModeless
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
With getNewControl(.Controls, "Forms.Label.1", Left1, 50, 20, Top)
.Caption = c.Value
.Tag = "'" & c.Parent.Name & "'!" & c.Address
End With
With getNewControl(.Controls, "Forms.Label.1", Left2, 50, 20, Top)
.Caption = c.Offset(0, 1).Value
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
End With
With getNewControl(.Controls, "Forms.ComboBox.1", Left3, 120, 20, Top)
.List = Array("Approved", "Partially Approved", "Not Approved")
.Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
.Value = c.Offset(0, 2).Value
End With
Top = Top + 20
Next
Set .CommandApp = getNewControl(.Controls, "Forms.Commandbutton.1", 10, 140, 20, Top + 10)
With .CommandApp
.Caption = "Submit"
End With
Set .CommandCan = getNewControl(.Controls, "Forms.Commandbutton.1", 170, 140, 20, Top + 10)
With .CommandCan
.Caption = "Cancel"
End With
End With
End Sub
Function getNewControl(Controls As MSForms.Controls, ProgID As String, Left As Single, Width As Single, Height As Single, Top As Single) As MSForms.Control
Dim ctrl As MSForms.Control
Set ctrl = Controls.Add(ProgID)
With ctrl
.Left = Left
.Width = Width
.Font.Size = 10
.Top = Top
End With
Set getNewControl = ctrl
End Function
Generally I'd set up classes and collections to hold references to your new controls.
It can work with your current set up though. First off I'll suggest an aesthetic change:
Set the size of your frame to a static size that fits on your screen and add the two command buttons outside of this.
Size the frame so it sits inside the bounds of your form.
Change the ScrollBars property to 2 - fmScrollBarsVertical.
In your code:
Add a new variable
Dim fme As Frame
Set fme = UserForm6.Frame1
Update your references to UserForm6 so they reference fme instead when you add the labels and combobox:
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
.
.
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
.
.
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
Outside your final loop add this line of code (you may have to play around with the maths to get the correct scroll height):
fme.ScrollHeight = buttonheight + 90
Remove the code that adds the two command buttons (as they're now static outside of the frame).
Now your whole form should sit on the page and you can scroll through the controls.
Double-click your command button to add a Click event to it:
Private Sub CommandButton1_Click()
Dim ctrl As Control
Dim x As Long
For Each ctrl In Me.Frame1.Controls
If TypeName(ctrl) = "ComboBox" Then
x = x + 1
ThisWorkbook.Worksheets("Sheet2").Cells(x, 1) = ctrl.Value
End If
Next ctrl
End Sub
The code will go through each combobox on the form and copy the selected value to Sheet2 in the workbook.
Edit:
All the code incorporating the changes I made.
Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long
Dim fme As Frame
Dim c As Variant
Dim labelCounter As Long
Set fme = UserForm6.Frame1
For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 10
.Width = 50
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)
With ComboBox1
.AddItem "Approved"
.AddItem "Partially Approved"
.AddItem "Not Approved"
.Left = 190
.Width = 120
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 30
Else
.Top = 30 + (20 * (c.Row - 1))
buttonheight = 30 + (20 * (c.Row - 1))
End If
End With
Next c
For Each c In Sheets("Sheet1").Range("B1:B100")
If c.Value = "" Then Exit For
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
With theLabel
.Caption = c
.Left = 90
.Width = 70
.Height = 20
.Font.Size = 10
If c.Row = 1 Then
.Top = 34
Else
.Top = 25 + (20 * (c.Row - 1)) + 9
End If
End With
Next c
fme.ScrollHeight = buttonheight + 90
End Sub
I want to add n number of text box and one command button during run time of the user form in excel - vba .
While the number 'n' , i am getting through a cell value .
I want to store the data entered ( in the dynamically during run time created text box when the user clicks on Submit button that is also run time created )
in excel sheet .
For i = 1 To ssheet.Cells(2, 2).Value
Set txtB1 = Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "d" & i
.Height = 25
.Width = 150
.Left = 105
.Top = 20 + 10 * i * 4
End With
Set cCont = Controls.Add("Forms.CommandButton.1", "Button", True)
With cCont
.Caption = "Submit"
.Top = 60 + 10 * ssheet.Cells(2, 2).Value * 4
.Left = 105
End With
Here i am able to display as required but unable to trigger the users button click and store values in excel sheet .
So create a userform and add the command button in design time like below
Add the following code in the user form
Private Sub CommandButton1_Click()
For i = 1 To ssheet.Cells(2, 2).Value
ssheet.Cells(i, 5).Value = Controls("d" & i).Value
Next i
Unload UserForm1
End Sub
Private Sub UserForm_Initialize()
If ssheet.Cells(2, 2).Value > 0 Then
For i = 1 To ssheet.Cells(2, 2).Value
Set txtB1 = Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "d" & i
.Height = 25
.Width = 150
.Left = 10
.Top = 30 * (i - 1) + 5
End With
Next i
With CommandButton1
.Caption = "Submit"
.Top = 30 * (i - 1) + 5
.Left = 10
End With
With Me
.Width = 200
.Height = 200
.ScrollTop = 0
.KeepScrollBarsVisible = fmScrollBarsVertical
.ScrollBars = fmScrollBarsVertical
.ScrollHeight = 30 * i + 5
End With
Else
CommandButton1.Visible = False
End If
End Sub
You can then call the userform from workbook module
Private Sub Workbook_Open()
UserForm1.Show
End Sub
When you load the form, the text boxes will be created and aligned based on B2 cell's value
I could really use some help on this. I've read through about 60+ websites and it's either not clicking (pun intended), or it's incorrect for my application. Here's the rundown:
Goal: Use a "Submit" button that was dynamically created in a Userform to copy the Caption from an OptionButton to a dynamic cell on the worksheet, and then clear/close the Userform.
Background: The userform is called from a change in a column in the worksheet.
Here's a snippet of the code used to call the userform:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim lastRow As Long
With Worksheets("Test")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
With Target
If .Count > 1 Then Exit Sub
If Not Intersect(Range("B1:B" & lastRow), .Cells) Is Nothing Then
Application.EnableEvents = False
If IsEmpty(.Value) Then
.Offset(0, 1).ClearContents
Else
With .Offset(0, 1)
.NumberFormat = "mmm dd yyyy hh:mm:ss"
.Value = Now
UserForm1.Show
End With
End If
Application.EnableEvents = True
End If
End With
End Sub
After the Userform is shown, it initializes. It pulls from a list on the spreadsheet to populate how many option buttons there are, their captions, and the dimensions of each item on the Userform. The code for that is this:
Sub UserForm_Initialize()
Dim HLastRow As Integer
Dim NoOfExplanations As Integer
Dim TopPixels As Integer
Dim UserFormHeight As Integer
Dim UserFormWidth As Integer
Dim Opt As Variant
Dim i As Integer
Dim ExplanationRow As Integer
Dim lbl As MSForms.Label
Dim LabelCap As String
Dim btn As CommandButton
Dim OtherInput As MSForms.TextBox
Dim Margins As Integer
With Worksheets("Test")
HLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
NoOfExplanations = Application.WorksheetFunction.CountA(Worksheets("Test").Range("H2:H" & HLastRow))
Margins = 20
LabelCap = "You have chosen a non sequential row for your team/subteam. Please select an explanation below before you are able to proceed"
UserFormWidth = Len(LabelCap) * 2
TopPixels = (18 * 2)
UserFormHeight = TopPixels + 80 + (20 * NoOfExplanations)
With UserForm1
.Width = UserFormWidth + 40
.Height = UserFormHeight
End With
Set lbl = UserForm1.Controls.Add("Forms.Label.1")
With lbl
.Top = 10
.Left = 20
.Height = 20
.Width = UserFormWidth - 20
.Caption = LabelCap
End With
ExplanationRow = 2
For i = 1 To NoOfExplanations
Set Opt = UserForm1.Controls.Add("Forms.OptionButton.1", "OptionButton" & i, True)
Opt.Caption = Worksheets("Test").Cells(ExplanationRow, 8).Value
If Worksheets("Test").Cells(ExplanationRow, 8).Value = "Other" Then
Set OtherInput = UserForm1.Controls.Add("Forms.TextBox.1")
With OtherInput
.Top = TopPixels
.Width = UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11)
.Left = UserFormWidth - (UserFormWidth - (Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) * 11))
.Height = 18
End With
End If
If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) > 45 Then
Opt.Width = UserFormWidth - 10
Opt.Height = 36
Opt.Left = 18
Opt.Top = TopPixels
TopPixels = TopPixels + 38
End If
If Len(Worksheets("Test").Cells(ExplanationRow, 8).Value) <= 45 Then
Opt.Width = UserFormWidth - 10
Opt.Height = 18
Opt.Left = 18
Opt.Top = TopPixels
TopPixels = TopPixels + 20
End If
ExplanationRow = ExplanationRow + 1
Next i
Set btn = UserForm1.Controls.Add("Forms.CommandButton.1")
With btn
.Top = TopPixels
.Width = 40
.Left = ((UserFormWidth + 40) / 2) - 20
.Height = 20
.Caption = "Submit"
.Name = btn
End With
End Sub
Question: So, how do I get the btn created here in the Userform to both copy the selected OptionButton caption to the dynamic cell, and then clear/close the Userform?
I know it's a stretch, but I'm trying to fill in the cell that is two columns over from the "Target" cell that triggers the Userform to open. The code fills in the current date/time in the .Offset(0, 1) in the Worksheet_Change snipped, but is there a way to place the OptionButton caption in the cell at .Offset(0, 2)?
I'm still pretty new to VBA and this one thing is really sticking a thorn in me.
I'll be incredibly grateful for any help on this.
Thanks!
Joe
Changing your btn variable to a class level variable and using WithEvents will allow you to access the dynamic buttons events.
Private WithEvents btn As CommandButton
Private Sub btn_Click()
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "OptionButton" Then
If ctrl.Object.Value Then
MsgBox ctrl.Object.Caption
End If
End If
Next
End Sub
Bottom Line Fix: Changing my dynamicly named textbox to have a _ separator between the column and row to get rid of the ambiguity of the names.
Previous Code:
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & r, True)
Fix:
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & "_" & r, True)
I have a userform and it has 15 text boxes columns by X rows (dynamic).
The user inputs numbers into the text boxes. Then I want them to hit a Print button on the user form to run the PrintLabel() sub and put those values into a spreadsheet vertically (B24:Bxx). Then have it print out the spreadsheet and return to the userform.
My issue is I can't seem to get the values from the textboxes.
The textbox names are in an multi-dimensional array style format:
PalletNumber & "row" & "column"
So the first row would be PalletNumber0_0 through PalletNumber0_15. The next row will be PalletNumber1_0 to PalletNumber1_15.
Update:
The user enters the value "1234" into a textbox and clicks "Look Up" to run lookup(). This then searches a spreadsheet for the number and gets all the rows that match and puts them into the userform.
Here is the code snippet
For Each c In Worksheets("Sheet1").range("A2:A" & iRowCount)
If c.value = OrderNumber Then
ReDim Preserve aGetData(6, i)
For a = 0 To 6 'Change this for total of columns Our first index will hold each col of data that is why
'it is set to 0 (arrays start at a base of zero, so
'0,1,2,3,4,5 will be each col(A,B,C).
aGetData(a, i) = c.Offset(0, a) 'This gets each value from col A,B and C
Next a
'Get the data and set it into variables.
ItemNumber = aGetData(5, i)
ItemQty = aGetData(2, i)
'Create "ItemQuantity" text box.
Set cCntrl = PickTicketForm.Controls.Add("Forms.Label.1", "ItemQuantity" & i, True)
With cCntrl
.Caption = ItemQty
.Width = 85
.Height = 18
.Top = 86 + (i * 20)
.Left = 40
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
End With
'Create "ItemNumber" box
Set cCntrl = PickTicketForm.Controls.Add("Forms.Label.1", "ItemNumber" & i, True)
With cCntrl
.Caption = ItemNumber
.Width = 340
.Height = 18
.Top = 86 + (i * 20)
.Left = 86
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
End With
'Create each inputbox for the pallets.
For r = 0 To 14
Set cCntrl = PickTicketForm.Controls.Add("Forms.TextBox.1", "PalletNumber" & i & "_" & r, True)
With cCntrl
.Width = 28
.Height = 18
.Top = 86 + (i * 20)
.Left = 354 + (r * 30)
.TextAlign = 1 'Left
.Font.Name = "Arial Black"
.Font.Size = "10"
.BackColor = BackgroundColor
.Text = i & r
End With
Next r
i = i + 1 'Increment for array in case we find another order number
'Our second index "aGetData(index1,index2) is being resized
'this represents each order number found on the sheet
LineCount = LineCount + 1
'Set the scroll bar height for the final form.
ScrollBarHeight = 150 + (i * 20)
End If
Next c
Here is that code snippet:
'Loop through first column completely ( 0 - 5 to test)
' i = 0 means go through every box in column 0 first
For i = 0 To 5
'Loop through rows.
For r = 0 To 2 '( 0 - 2 rows to test)
ActiveCell.Offset(i, 0).value = PickTicketForm.Controls("PalletNumber" & i & r).Text
Next r
Next i
Here is the userform layout:
The spreadsheet output should look like this:
You should add your controls within a For i = 0 To 5 loop as well.
If it remains empty you are adding PalletNumber0, PalletNumber1, PalletNumber2 etc. while you are searching for PalletNumber00, PalletNumber01, PalletNumber02 etc.
Read all the rows for one column & display on textbox(s) which are created at run time.I am turning over to seek you assistance for below after several attempts which didn't help.
Name
ABC
AB
ABCEF
GHFD
I want all the rows from excel sheet to be shown in textbox just as they appear in sheet for a particular column.I am creating 4 textbox(s) that represent columns & 11 textbox(s) that represent rows. For the first column, I want the data to be displayed as it is in sheet. I am successful in creating text box as per my requirement but not able to display data as per needs. Thanks a ton for help
Public Sub UserForm_Initialize()
Set sh = ThisWorkbook.Sheets("Testing")
sh.Range("F21").Activate
With sh
fatalcount = WorksheetFunction.CountIf(Range("F:F"), "Fatal")
Majorcount = WorksheetFunction.CountIf(Range("F:F"), "Major")
Minorcount = WorksheetFunction.CountIf(Range("F:F"), "Minor")
End With
For jrow = 1 To 11
For i = 0 To 4
Set txtB1 = WtmsFrm.Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "chkDemo" & i
.Height = 20
.Width = 5 + 50 + 5
.Left = 10 + 50 * i + 2
.Top = 15 * jrow + 10
.ControlTipText = "Type of Bug"
End With
Next i
Next jrow
For Each tbox In Frm.Controls
' For counter = 2 To 11
If tbox.Name = "chkDemo" Then
tbox.Value = Sheets("sheet1").Cells(counter, 2).Value ' failing code
tbox.ControlTipText = "Name"
ElseIf tbox.Name = "chkDemo1" Then
tbox.Value = 1
ElseIf tbox.Name = "chkDemo2" Then
tbox.Value = 2
ElseIf tbox.Name = "chkDemo3" Then
tbox.Value = 3
ElseIf tbox.Name = "chkDemo4" Then
tbox.Value = 4
End If
' Next counter
Next
' Initialise the followings
Frm.txtFatal.Value = fatalcount
Frm.txtMajor.Value = Majorcount
Frm.txtMinor.Value = Minorcount
Frm.txtTotoal.Value = fatalcount + Majorcount + Minorcount
End Sub
I don't see you create a textbox named "chkDemo". They all have a number appended. As you take tbox from all controls, there might be a control on your sheet somewhere named "chkDemo" but which is not a textbox. Neither do I see counter declared or initialized. That might also let the code fail.
Note also that with .Name = "chkDemo" & i you give the same name to textboxes because you are also in a For jrow loop.