Dynamic userform at runtime

O

Ouka

Hi all,

I'm trying to create a dynamic userform that is built at runtime. I a
able to get the form to build for my first column of data, but beyon
that it does not work and I error out no matter what I've tried. Wha
I need to happen is to take 5 columns worth of data (cols 25:29) from
hidden worksheet ("Hidden1") and dump them into a userform that allow
the user to edit the data, then return that data back to the hidde
sheet, replacing what was there originally. The form has to be buil
at runtime because the number of rows of data will change depending o
when the user fires the code.

The following code works to pull a list of data off o
worsheets("hidden1") col 26 and drop the values into textboxes in
userform. The code in red is what I've tried to do to make the cod
grab data from col 27 as well but it doesn't work...

Option Explicit

'Passed back to the function from the UserForm
Public GetTVals_ret_val As Variant
-------------------------------------------------------------
Build the form
Function GetTextVal(txtDateArray, Default, Title)
'Function GetTextVal(txtDateArray, *txtNameArray,* Default, Title)

Dim TempForm As Object
Dim tDateBox As MSForms.Textbox
'Dim tNameBox as MSForms.Textbox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim i As Integer, j as integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String

'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = True

'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(*4*)
'vbext_ct_MSForm
TempForm.Properties("Width") = 5000

'Add the treatment Date
TopPos = 4

For i = LBound(txtDateArray) To UBound(txtDateArray)
Set tDateBox
TempForm.Designer.Controls.Add("forms.TextBox.1")
With tDateBox
.Width = 50
.Value = txtDateArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = False

If Default = i Then .Value = True

End With
TopPos = TopPos + 15
Next i

''Add the treatment Name
'TopPos = 4
'For j = LBound(txtNameArray) To UBound(txtNameArray)
'Set tDateBox
TempForm.Designer.Controls.Add("forms.TextBox.1")
'With tNameBox
'.Width = 50
'.Value = txtNameArray(j)
'.Height = 15
'.Left = 58
'.Top = TopPos
'.Tag = j
'.AutoSize = False

'If Default = j Then .Value = True

'End With
'TopPos = TopPos + 15
'Next j
' Add the Cancel button
Set NewCommandButton1
TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
.Caption = "Cancel"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 6
End With
' Add the OK button
Set NewCommandButton2
TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
.Caption = "OK"
.Height = 18
.Width = 44
.Left = MaxWidth + 12
.Top = 28
End With

' Add event-hander subs for the CommandButtons (Not really sure ho
any of this works, but it does so *shrug*)

Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " GetTVals_ret_val=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " GetTVals_ret_val = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) = ""TextBox"" Then" & vbCrLf
Code = Code & " If ctl Then GetTVals_ret_val = ctl.Tag"
vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub"

With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With

' Adjust the form
With TempForm
.Properties("Caption") = Title
.Properties("Width") = NewCommandButton1.Left
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
.Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
.Properties("Height") = TopPos + 24
End With

' Show the form
VBA.UserForms.Add(TempForm.Name).Show

' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

' Pass the selected option back to the calling procedure
GetTextVal = GetTVals_ret_val
End Function

-----------------------------------------------------------
'Get values to populate the form
Sub GetEditValues()
Dim tDate()
'Dim tName()
Dim DateBox, i, Cnt', NameBox, j
Dim lRow As Long

With Worksheets("Hidden1")
lRow = .Cells(Rows.Count, 26).End(xlUp).Row
ReDim tDate(1 To lRow)
For i = 1 To lRow
tDate(i) = .Cells(i, 26)
Next i
'ReDim tName(1 To lRow)
'For j = 1 To lRow
'
tName(i) = .Cells(j, 27)
'Next j

DateBox = GetTextVal(tDate, 0, "Edit treatments")
'DateBox = GetTextVal(tdate, tName, 0, "Edit Treatments") ****I
suspect this is where my chief problem is****
End With

End Sub

Like I said, this code (wihtout the red) works fine. It's when I try
to add the next row of data from col 27 in parallel textboxes do things
stop working. I got this code from a textbook so I'm not entirely sure
what I need to modify to make it work the way I need to.​
 
D

Dave Peterson

Without looking at any of your code....

Have you thought about designing the form for the worst case--but hide the
textboxes that aren't required when you load the form.

It might be an easier approach.
Hi all,

I'm trying to create a dynamic userform that is built at runtime. I am
able to get the form to build for my first column of data, but beyond
that it does not work and I error out no matter what I've tried. What
I need to happen is to take 5 columns worth of data (cols 25:29) from a
hidden worksheet ("Hidden1") and dump them into a userform that allows
the user to edit the data, then return that data back to the hidden
sheet, replacing what was there originally. The form has to be built
at runtime because the number of rows of data will change depending on
when the user fires the code.

The following code works to pull a list of data off of
worsheets("hidden1") col 26 and drop the values into textboxes in a
userform. The code in red is what I've tried to do to make the code
grab data from col 27 as well but it doesn't work...

Option Explicit

'Passed back to the function from the UserForm
Public GetTVals_ret_val As Variant
-------------------------------------------------------------
Build the form
Function GetTextVal(txtDateArray, Default, Title)
'Function GetTextVal(txtDateArray, *txtNameArray,* Default, Title)

Dim TempForm As Object
Dim tDateBox As MSForms.Textbox
'Dim tNameBox as MSForms.Textbox
Dim NewCommandButton1 As MSForms.CommandButton
Dim NewCommandButton2 As MSForms.CommandButton
Dim i As Integer, j as integer, TopPos As Integer
Dim MaxWidth As Long
Dim Code As String

'Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = True

'Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
'Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(*4*)
'vbext_ct_MSForm
TempForm.Properties("Width") = 5000

'Add the treatment Date
TopPos = 4

For i = LBound(txtDateArray) To UBound(txtDateArray)
Set tDateBox =
TempForm.Designer.Controls.Add("forms.TextBox.1")
With tDateBox
Width = 50
Value = txtDateArray(i)
Height = 15
Left = 8
Top = TopPos
Tag = i
AutoSize = False

If Default = i Then .Value = True

End With
TopPos = TopPos + 15
Next i

''Add the treatment Name
'TopPos = 4
'For j = LBound(txtNameArray) To UBound(txtNameArray)
'Set tDateBox =
TempForm.Designer.Controls.Add("forms.TextBox.1")
'With tNameBox
'.Width = 50
'.Value = txtNameArray(j)
'.Height = 15
'.Left = 58
'.Top = TopPos
'.Tag = j
'.AutoSize = False

'If Default = j Then .Value = True

'End With
'TopPos = TopPos + 15
'Next j
' Add the Cancel button
Set NewCommandButton1 =
TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton1
Caption = "Cancel"
Height = 18
Width = 44
Left = MaxWidth + 12
Top = 6
End With
' Add the OK button
Set NewCommandButton2 =
TempForm.Designer.Controls.Add("forms.CommandButton.1")
With NewCommandButton2
Caption = "OK"
Height = 18
Width = 44
Left = MaxWidth + 12
Top = 28
End With

' Add event-hander subs for the CommandButtons (Not really sure how
any of this works, but it does so *shrug*)

Code = ""
Code = Code & "Sub CommandButton1_Click()" & vbCrLf
Code = Code & " GetTVals_ret_val=False" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub" & vbCrLf
Code = Code & "Sub CommandButton2_Click()" & vbCrLf
Code = Code & " Dim ctl" & vbCrLf
Code = Code & " GetTVals_ret_val = False" & vbCrLf
Code = Code & " For Each ctl In Me.Controls" & vbCrLf
Code = Code & " If TypeName(ctl) = ""TextBox"" Then" & vbCrLf
Code = Code & " If ctl Then GetTVals_ret_val = ctl.Tag" &
vbCrLf
Code = Code & " End If" & vbCrLf
Code = Code & " Next ctl" & vbCrLf
Code = Code & " Unload Me" & vbCrLf
Code = Code & "End Sub"

With TempForm.CodeModule
.InsertLines .CountOfLines + 1, Code
End With

' Adjust the form
With TempForm
Properties("Caption") = Title
Properties("Width") = NewCommandButton1.Left +
NewCommandButton1.Width + 10
If .Properties("Width") < 160 Then
Properties("Width") = 160
NewCommandButton1.Left = 106
NewCommandButton2.Left = 106
End If
Properties("Height") = TopPos + 24
End With

' Show the form
VBA.UserForms.Add(TempForm.Name).Show

' Delete the form
ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm

' Pass the selected option back to the calling procedure
GetTextVal = GetTVals_ret_val
End Function

-----------------------------------------------------------
'Get values to populate the form
Sub GetEditValues()
Dim tDate()
'Dim tName()
Dim DateBox, i, Cnt', NameBox, j
Dim lRow As Long

With Worksheets("Hidden1")
lRow = .Cells(Rows.Count, 26).End(xlUp).Row
ReDim tDate(1 To lRow)
For i = 1 To lRow
tDate(i) = .Cells(i, 26)
Next i
'ReDim tName(1 To lRow)
'For j = 1 To lRow
'
tName(i) = .Cells(j, 27)
'Next j

DateBox = GetTextVal(tDate, 0, "Edit treatments")
'DateBox = GetTextVal(tdate, tName, 0, "Edit Treatments") ****I
suspect this is where my chief problem is****
End With

End Sub

Like I said, this code (wihtout the red) works fine. It's when I try
to add the next row of data from col 27 in parallel textboxes do things
stop working. I got this code from a textbook so I'm not entirely sure
what I need to modify to make it work the way I need to.
​
Click to expand...
​
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

getting text out of TextBox into code 0
creating frame and option buttons programmatically 2
Remove Identical words 0
VBA - (re-) Set a Table Style 2
Minimizing a user form 1
Problem with Blocking Dynamically generated UserForm Call 4
Loop through pages and insert header image 0
VBA Export to PDF 0

Top