Option Button Class Module

[RawlinsCross]

Having a problem setting up a class module around several option buttons I have a multipage userform (1st page). I'm getting an error on the "Redim Preserve" line - "Subscript out of range". Any idea what I'm doing wrong? Is this a multipage vs. userform issue?

Userform Code

Option Explicit

Private FilterPress() As New FilterPressClass

'public properties
Public Property Let SelectedFP(sSelectedFP As String)
msSelectedFP = sSelectedFP
End Property

Private Sub UserForm_Initialize()
Call PopulateControlArrays
End Sub

Private Sub PopulateControlArrays()

Dim Ctrl As Control
Dim lFPCount As Long

For Each Ctrl In Me.MultiPage1.Pages(0).Controls
If TypeName(Ctrl) = "OptionButton" Then
lFPCount = lFPCount + 1
ReDim Preserve FilterPress(1 To lFPCount) 'GETTING THE ERROR HERE!
Set FilterPress(lFPCount).FilterPressGroup = Ctrl
' link to this instance of UserGUI
Set FilterPress(lFPCount).FilterPressGroup.Parent = Me
End If
Next Ctrl

End Sub

Public Sub FPSet()
MsgBox msSelectedFP
End Sub

Class Module Code

Option Explicit

Public WithEvents FilterPressGroup As MSForms.Control

Private mfrmParent As UserForm

'--public properties
Public Property Set Parent(frmParent As UserForm)
Set mfrmParent = frmParent
End Property

'--event procedures
Private Sub FilterPressGroup_Click()

FilterPressGroup.Parent.SelectedFP = FilterPressGroup.Name
FilterPressGroup.Parent.FPSet

End Sub

 

[Domenic]

ReDim Preserve FilterPress(1 To lFPCount) The only way I can see that you get that error is if IFPCount is equal to 0 when this line is executed. Check to see what value is actually assigned when it's executed.

Set FilterPress(lFPCount).FilterPressGroup = Ctrl You'll also get an error on this line because you've declared FilterPressGroup in your class as MSForms.Control. You'll need to declare it as MSForms.OptionButton.

Set FilterPress(lFPCount).FilterPressGroup.Parent = Me I'm not sure what you're trying to do here, but you'll also get an another error since you're trying to assign your userform to your page from your multipage control.

 

[RawlinsCross]

hi Domenic - thanks for your reply. I have confirmed the lFPCount is reading 1 before the "ReDim Preserve". I also changed MSForms.Control to MSForms.OptionButton. As for the third point, the code errors even before that is run. Still getting the same error.

I have put in a watch on the Expression FilterPress and see the following:

 

[RawlinsCross]

So some progress... I advanced the breakpoint to the next line and the 'out of range' error disappeared . Got other errors but was quickly able to diagnose. I can place MsgBox checks in the Class module to see how far I'm advancing. See below to see how far I advanced into the class. It's seems I've having an issue with the Parent line in the Userform code. What is the correct assignment of the Parent property here?

Userform code

Option Explicit

Private FilterPress() As New FilterPressClass

'public properties
Public Property Let SelectedFP(sSelectedFP As String)
msSelectedFP = sSelectedFP
End Property

Private Sub UserForm_Initialize()
Call PopulateControlArrays
End Sub

Private Sub InitializeControls()

Me.MultiPage1.TabFixedWidth = 100
Me.MultiPage1.TabFixedHeight = 20
Me.ShiftSelect.List = Array("DS", "NS")
Me.FP1_OB.Value = True

End Sub

Private Sub PopulateControlArrays()

Dim Ctrl As Control
Dim lFPCount As Long

For Each Ctrl In Me.MultiPage1.Pages(0).Controls
If TypeName(Ctrl) = "OptionButton" Then
lFPCount = lFPCount + 1
ReDim Preserve FilterPress(1 To lFPCount)
Set FilterPress(lFPCount).FilterPressGroup = Ctrl
' link to this instance of UserGUI
Set FilterPress(lFPCount).Parent = Me
End If
Next Ctrl

End Sub

Public Sub FPSet()
MsgBox "You've gotten this far"
End Sub

Class Module

Option Explicit

Public WithEvents FilterPressGroup As MSForms.OptionButton

Private mfrmParent As UserForm

'--public properties
Public Property Set Parent(frmParent As UserForm)
Set mfrmParent = frmParent
End Property

'--event procedures

Private Sub FilterPressGroup_Click()

MsgBox FilterPressGroup.Caption  'This Works and gives the correct caption of the option button
'FilterPressGroup.Parent.SelectedFP = FilterPressGroup.Caption 'commented out for now
FilterPressGroup.Parent.FPSet 'to see if I can run this
'nope that line does not run. I get:
'Object doesn't support this property or method
End Sub

 

[Domenic]

With regards to your original error, it looks like the error occurs whenever a breakpoint and watch are added at the same time, as you have done and shown in your earlier post. Without the watch, the error doesn't seem to occur. It may be a bug of some sort.

With regards to the code in your userform, you're trying to assign a string to msSelectedFP, however you haven't defined it. You'll need to declare it as a private variable at the module level...

Private msSelectedFP As String

With regards to the code in your class module, declare mfrmParent as an Object, instead of a UserForm...

Private mfrmParent As Object

Then, declare the parameter frmParent in the property Parent as an Object, instead of UserForm...

Public Property Set Parent(frmParent As Object)

Then, lastly, to call the method FPSet, you can qualify the reference with mfrmParent...

mfrmParent.FPSet

So your code should be as follows...

FilterPressClass

Option Explicit

Public WithEvents FilterPressGroup As MSForms.OptionButton
Private mfrmParent As Object

'--public properties
Public Property Set Parent(frmParent As Object)
    Set mfrmParent = frmParent
End Property

'--event procedures
Private Sub FilterPressGroup_Click()
    MsgBox FilterPressGroup.Caption
    mfrmParent.FPSet
End Sub

UserForm

Option Explicit

Private FilterPress() As New FilterPressClass
Private msSelectedFP As String

'public properties
Public Property Let SelectedFP(sSelectedFP As String)
    msSelectedFP = sSelectedFP
End Property

Private Sub UserForm_Initialize()
    Call PopulateControlArrays
End Sub

Private Sub InitializeControls()

    Me.MultiPage1.TabFixedWidth = 100
    Me.MultiPage1.TabFixedHeight = 20
    Me.ShiftSelect.List = Array("DS", "NS")
    Me.FP1_OB.Value = True

End Sub

Private Sub PopulateControlArrays()

    Dim Ctrl As Control
    Dim lFPCount As Long
    
    For Each Ctrl In Me.MultiPage1.Pages(0).Controls
        If TypeName(Ctrl) = "OptionButton" Then
            lFPCount = lFPCount + 1
            ReDim Preserve FilterPress(1 To lFPCount)
            Set FilterPress(lFPCount).FilterPressGroup = Ctrl
            ' link to this instance of UserGUI
            Set FilterPress(lFPCount).Parent = Me
        End If
    Next Ctrl

End Sub

Public Sub FPSet()
    MsgBox "You've gotten this far"
End Sub

Hope this helps!

 

[RawlinsCross]

Worked like a charm. Curious, why do you have to replace "Userform" with "Object" in the class module?

 

[Domenic]

As you know, when you insert a userform into a VBA project, it's automatically given a default name. And, as you may also know, it's assigned a newly created class type.

So, for example, let's say that you insert your first userform into a project. As such, it will be given the default name UserForm1, and assigned the class type UserForm1.

However, if you rename the userform from UserForm1 to, let's say, frmSurvey, the class type for this userform changes from UserForm1 to frmSurvey. As you can see, the name of the class changes along with the name of the userform.

With this in mind, let's take a look at a couple of examples. For each example, we have a workbook that contains 2 userforms. The first one is called MyForm, and the second one is called MyOtherForm. Accordingly, we have 2 new classes, MyForm and MyOtherForm, respectively.

In our first example, we have a procedure that accepts a specific class of userforms. It accepts userforms that has a MyForm class type. So this means that it won't accept a userform with MyOtherForm as the class type.

Sub test1()
    
    ExplicitTypeProcedure MyForm 'default instance of class type MyForm OK
    
    Dim frm1 As MyForm
    Set frm1 = New MyForm
    ExplicitTypeProcedure frm1 'new instance of class type MyForm OK
    
    ExplicitTypeProcedure MyOtherForm 'type mis-match error
    
    Dim frm2 As MyOtherForm
    Set frm2 = New MyOtherForm
    ExplicitTypeProcedure frm2 'type mis-match error
    
End Sub

Sub ExplicitTypeProcedure(ByVal frm As MyForm) 'specific class type
    frm.Show
End Sub

In our second example, we have a procedure where the parameter is declared as a generic object. In doing it this way, it will accept userforms that have either class type. Note that the class type will be resolved at runtime.

Sub test2()
    
    GenericTypeProcedure MyForm 'default instance of class type MyForm OK
    
    Dim frm1 As MyForm
    Set frm1 = New MyForm
    GenericTypeProcedure frm1 'new instance of class type MyForm OK
    
    GenericTypeProcedure MyOtherForm 'default instance of class type MyOtherForm OK
    
    Dim frm2 As MyOtherForm
    Set frm2 = New MyOtherForm
    GenericTypeProcedure frm2 'new instance of class type MyOtherForm OK
    
End Sub

Sub GenericTypeProcedure(ByVal frm As Object) 'class type resolved at runtime
    frm.Show
End Sub

In your example, you declare the parameter for your function as UserForm, which is a totally different class defined in the MSForms library. The properties and methods differ somewhat from the classes that are created for our userforms. Specifically, it does not contain a Show method. Unfortunately, I don't know in what context it would be used. Maybe someone else here could shed some light.

Anyway, I hope it helps, cheers!