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
'
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.
'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.