Hi All,
I have the code below which works very well and creates a Temp form that allows one selection from a set range.
My Issue is that I have to amend the code so that the user can select more than one option? Can anyone please help??
I then have a separate macro that uses the temp form with a named range as below;
Many thanks
I have the code below which works very well and creates a Temp form that allows one selection from a set range.
My Issue is that I have to amend the code so that the user can select more than one option? Can anyone please help??
Code:
Option Explicit
'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant
Function GetOption(OpArray, Default, Title)
Dim TempForm 'As VBComponent
Dim NewOptionButton As Msforms.OptionButton
Dim NewCommandButton1 As Msforms.CommandButton
Dim NewCommandButton2 As Msforms.CommandButton
Dim TextLocation As Integer
Dim X As Integer, i As Integer, TopPos As Integer
Dim MaxWidth As Long
Dim WasVisible As Boolean
' Hide VBE window to prevent screen flashing
Application.VBE.MainWindow.Visible = False
' Create the UserForm
Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
TempForm.Properties("Width") = 800
' Add the OptionButtons
TopPos = 4
MaxWidth = 0 'Stores width of widest OptionButton
For i = LBound(OpArray) To UBound(OpArray)
Set NewOptionButton = TempForm.Designer.Controls.Add("forms.OptionButton.1")
With NewOptionButton
.Width = 800
.Caption = OpArray(i)
.Height = 15
.Left = 8
.Top = TopPos
.Tag = i
.AutoSize = True
If Default = i Then .Value = True
If .Width > MaxWidth Then MaxWidth = .Width
End With
TopPos = TopPos + 15
Next i
' 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 = 28 '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 = 6 '28
End With
' Add event-hander subs for the CommandButtons
With TempForm.CodeModule
X = .CountOfLines
.InsertLines X + 1, "Sub CommandButton1_Click()"
.InsertLines X + 2, " GETOPTION_RET_VAL=False"
.InsertLines X + 3, " Unload Me"
.InsertLines X + 4, "End Sub"
.InsertLines X + 5, "Sub CommandButton2_Click()"
.InsertLines X + 6, " Dim ctl"
.InsertLines X + 7, " GETOPTION_RET_VAL = False"
.InsertLines X + 8, " For Each ctl In Me.Controls"
.InsertLines X + 9, " If ctl.Tag <> """" Then If ctl Then GETOPTION_RET_VAL = ctl.Tag"
.InsertLines X + 10, " Next ctl"
.InsertLines X + 11, " Unload Me"
.InsertLines X + 12, "End Sub"
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
GetOption = GETOPTION_RET_VAL
End FunctionI then have a separate macro that uses the temp form with a named range as below;
Code:
Sub Period2() 'Select Overall Reporting Period - The [$-0809] forces the date to English Dim Ops() As Variant
Dim Cnt As Integer, i As Integer
Dim UserChoice As Variant
Cnt = Range("Mths").Count
ReDim Ops(1 To Cnt)
For i = 1 To Cnt
Ops(i) = Format(Range("Mths").Range("A1").Offset(i - 1, 0), "[$-0809]dd-mmm-yy")
Next i
UserChoice = GetOption(Ops, 1, "Select Your Reporting Period")
If UserChoice = False Then
Range("R14") = ""
Else
Range("R14") = Ops(UserChoice)
End If
End SubMany thanks
Last edited:
