create text box by row & column on a userform vba - vba

Could any one direct me in right direction for the following code? I want to create a text box at run time by row & column.The following creates only a row & not multiple rows. I want the columns to remain same & just keep increasing rows. Thanks in advance :)
Dim txtB1 As Control
Dim i
For i = 0 To 4
Set txtB1 = UserForm.Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "chkDemo" & i
.Height = 20
.Width = 50
.Left = 30 * i * 2
.Top = 15
.ControlTipText = "Type of Bug"
End With
Next i

You need a For loop for each dimension (rows and columns).
Dim txtB1 As Control
Dim i, jrow
For jrow = 1 To 5
For i = 0 To 4
Set txtB1 = UserForm.Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "chkDemo" & i
.Height = 20
.Width = 50
.Left = 50 * i + 2
.Top = 20 * jrow + 15
.ControlTipText = "Type of Bug"
End With
Next i
Next jrow
Result:

Related

Extracting data from a dynamic userform VBA

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

Accesing Controls in Excel VBA Userform

I am creating form controls in a custom userform and have having difficulty in accesing them after creation. The amount of ComboBoxes and TextBoxes depends on user input. I am using a CommandButton to figure the correct syntax, but am at a loss to find the control. I have used several different naming conventions inside the CommandButton_Click method and nothing works.
My code for the userform to create my controls is as follows:
Sub createDetails()
Dim details As Variant
details = TextBox3.Value
remainTot = TextBox2.Value
If TextBox3.Value = "" Or TextBox3.Value = 0 Then
MsgBox "Must have at least 1 detail"
Exit Sub
Else
End If
For i = 1 To details
n = i - 1
Dim SubPay As Control
Dim CatPay As Control
Dim AmtPay As Control
Set theLbl = frmInvoice.Controls.Add("Forms.Label.1", "lbl_" & i, True)
With theLbl
.Caption = "Detail " & i
.Left = 20
.Width = 60
.Top = n * 24 + 110
.Font.Size = 10
End With
Set SubPay = frmInvoice.Controls.Add("Forms.ComboBox.1", "SubComboBox_" & i, True)
With SubPay
.Top = 108 + (n * 24)
.Left = 60
.Height = 18
.Width = 100
.Name = "subBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 6
.TabStop = True
.RowSource = "PayeeList"
End With
Set CatPay = frmInvoice.Controls.Add("Forms.ComboBox.1", "CatComboBox_" & i, True)
With CatPay
.Top = 108 + (n * 24)
.Left = 165
.Height = 18
.Width = 100
.Name = "catBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 7
.TabStop = True
.RowSource = "CatList"
End With
Set AmtPay = frmInvoice.Controls.Add("Forms.TextBox.1", "AmtTextBox" & i, True)
With AmtPay
.Top = 108 + (n * 24)
.Left = 270
.Height = 18
.Width = 50
.Name = "amtBox" & i
.Font.Size = 10
.TabIndex = n * 3 + 8
.TabStop = True
End With
Next i
Dim TBox As Control
Set TBox = frmInvoice.Controls.Add("Forms.TextBox.1", "TotalLbl", True)
With TBox
.Top = 130 + ((details - 1) * 24)
.Left = 270
.Height = 18
.Width = 50
.Name = "totBox"
.Font.Size = 10
'.TabIndex = (details - 1) * 3 + 9
.TabStop = False
.Value = TextBox2.Value
End With
Set theLbl = frmInvoice.Controls.Add("Forms.Label.1", "totLbl", True)
With theLbl
.Caption = "Total"
.Left = 225
.Width = 40
.Top = 135 + ((details - 1) * 24)
.Font.Size = 10
End With
frmInvoice.Height = 200 + details * 24
With CommandButton1
.Top = 150 + details * 24
.TabStop = True
.TabIndex = (details - 1) * 3 + 9
End With
With CommandButton2
.Top = 150 + details * 24
.TabStop = False
'.TabIndex = (details - 1) * 3 + 10
End With
End Sub
The code for the CommndButton which doesn't work is:
Private Sub CommandButton1_Click()
frmInvoice.Controls("amtBox1").Value = 1
frmInvoice.Controls(amtBox1).Value = 2
frmInvoice.Controls(AmtTextBox1).Value = 3
frmInvoice.Controls("AmtTextBox1").Value = 4
End Sub
Any help is greatly appreciated.
Screen shot of my userform:
Try using
frmInvoice.Controls("amtBox1").Text
instead of
frmInvoice.Controls("amtBox1").Value
I think your error because of
Private Sub CommandButton1_Click()
frmInvoice.Controls("amtBox1").Value = 1 'is true
frmInvoice.Controls(amtBox1).Value = 2 'is false because there isn't double quotes
frmInvoice.Controls(AmtTextBox1).Value = 3 'is false because there isn't dobule quotes
frmInvoice.Controls("AmtTextBox1").Value = 4 'is false the AmtTextBoxt1 name is changed "amtBox1"
End Sub
Maby, Do you want to this?
Private Sub CommandButton1_Click()
Dim i As Integer
Dim total As Currency
With frmInvoice
For i = 1 To TextBox3.Value
total = total + .Controls("amtBox" & i).Value
Next i
.Controls("totBox").Text = Format(total, "####.00")
End With
End Sub

Excel VBA value dynamicly named textboxes

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.

Populate TextBox's in VBA

I am using a form to show outstanding work. the code creates a number of textboxes based on the number of rows used on a sheet call "Jobcardslive"
I can get it to create the right number of textboxes on the form but i would also like to populate the textboxes with a value stored in Row A
e.g If I have 4 rows populated on the sheet it will create 4 textboxes named vehicle1 - 4 etc
I would also like it to populate vehicle1 with A1 from the sheet and vehicle2 with A2 etc
The boxes are created fine
the code i am using at the moment is
Dim txtB1 As Control
Dim TextBox_Name As String
Dim f As String
f = ThisWorkbook.Sheets("Jobcardslive").Range("A" & Rows.Count).End(xlUp).Row - 1
Dim i
For i = 0 To f
Set txtB1 = Controls.Add("Forms.TextBox.1")
With txtB1
.Name = "vehicle" & i
.Height = 20
.Width = 200
.Left = 10
.Top = 10 * i * 2
End With
Next i
Any help would be greatly appreciated
you could go like follows:
Dim txtB1 As MSForms.TextBox '<--| declare it as a TextBox instead of Control, to have Intellisense show you real `Textbox` object specific members
Dim i As Long
With ThisWorkbook.Sheets("Jobcardslive")
For i = 1 To .Range("A" & .Rows.Count).End(xlUp).Row
Set txtB1 = Me.Controls.Add("Forms.TextBox.1")
SetTextBox txtB1, i, Range("A" & i).value
Next i
End With
thus also demanding to the following specific Sub SetTextBox the task of properly initializing the textbox:
Sub SetTextBox(txtB As MSForms.TextBox, i As Long, v As Variant)
With txtB
.name = "vehicle" & i
.height = 20
.Width = 200
.Left = 10
.Top = 10 * i * 2
.value = v
End With
End Sub

read a column from a excel sheet & display on textbox vba

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.