Same code for Multiple optionbuttons

[Xalova]

Hey.
I have in a userform mutliple optionbuttons that, when the keydown event is called they all should do the same thing.
for example

Private Sub optbt1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'KeyCode 9=Tab 13=Enter
If KeyCode = 13 Then
    me.optbt1 = True
    Me.Frame2.SetFocus
End If

End Sub

and thats what should happen for optbt1-8

is there a way to generalize this code?
i thought about using a class but then i would have the problem that the name of each optbt is different..

any ideas?

 

[Domenic]

Actually, a class module is the way to go. Try the following:

1) First, insert a class module (Visual Basic Editor >> Insert >> Class Module), name the class module "clsOptionButton" (Properties Window >> Name), and copy and paste the following code into the code module...

Option Explicit

Dim WithEvents m_optionButton As MSForms.optionButton
Dim m_userForm As Object

Public Property Set optionButton(ByRef ob As MSForms.optionButton)
    Set m_optionButton = ob
    Set m_userForm = ob.Parent.Parent
End Property

Private Sub m_optionButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        m_optionButton.Value = True
        m_userForm.Frame2.SetFocus
    End If
End Sub

2) Then copy and paste the following code into the code module for your UserForm...

Option Explicit

Dim colOptionButtons As Collection

Private Sub UserForm_Initialize()

    Set colOptionButtons = New Collection
 
    Dim ctrl As MSForms.Control
    Dim ob As clsOptionButton
    For Each ctrl In Me.Controls
        If ctrl.Name Like "optbt[1-9]" Then
            Set ob = New clsOptionButton
            Set ob.optionButton = ctrl
            colOptionButtons.Add ob
        End If
    Next ctrl

End Sub

Note, while your option buttons may be located within a frame, I've assumed that Frame2 refers to a separate frame, since the frame containing the option buttons would already have focus.

Hope this helps!

 

[Xalova]

Actually, a class module is the way to go. Try the following:

1) First, insert a class module (Visual Basic Editor >> Insert >> Class Module), name the class module "clsOptionButton" (Properties Window >> Name), and copy and paste the following code into the code module...

Option Explicit

Dim WithEvents m_optionButton As MSForms.optionButton
Dim m_userForm As Object

Public Property Set optionButton(ByRef ob As MSForms.optionButton)
    Set m_optionButton = ob
    Set m_userForm = ob.Parent.Parent
End Property

Private Sub m_optionButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        m_optionButton.Value = True
        m_userForm.Frame2.SetFocus
    End If
End Sub

2) Then copy and paste the following code into the code module for your UserForm...

Option Explicit

Dim colOptionButtons As Collection

Private Sub UserForm_Initialize()

    Set colOptionButtons = New Collection
 
    Dim ctrl As MSForms.Control
    Dim ob As clsOptionButton
    For Each ctrl In Me.Controls
        If ctrl.Name Like "optbt[1-9]" Then
            Set ob = New clsOptionButton
            Set ob.optionButton = ctrl
            colOptionButtons.Add ob
        End If
    Next ctrl

End Sub

Note, while your option buttons may be located within a frame, I've assumed that Frame2 refers to a separate frame, since the frame containing the option buttons would already have focus.

Hope this helps!

im sure that it helps... but it seems that i have shot myself in the leg by simplyfying things.

My optiobuttons actually are not named "optbt1" or even similar like that. they all have different names, but all the same prefix. i also have 2 different sets of optionbuttons. set 1 with 9 buttons has the prefix "opt" and in set 2 i have 4 buttonswith the prefix "Stat". But fundamentally they should do the same, except that they should focus different things after pressing enter.

i am sorry for the inconvenience..

also just for my understanding of this code: couldnt both "option explicit" be in a seperate module? just to clear the code up a bit?
and since i have already a bunch of code in my "initialize" sub, does the placement of this code matter? should i look out for something?

 

[Domenic]

set 1 with 9 buttons has the prefix "opt" and in set 2 i have 4 buttonswith the prefix "Stat".

In that case, simply replace...

If ctrl.Name Like "optbt[1-9]" Then

with

If LCase$(Left$(ctrl.Name, 3)) = "opt" Or LCase$(Left$(ctrl.Name, 4)) = "stat" Then

also just for my understanding of this code: couldnt both "option explicit" be in a seperate module? just to clear the code up a bit?

No, the Option Explicit statement only applies to it's respective module.

and since i have already a bunch of code in my "initialize" sub, does the placement of this code matter? should i look out for something?

No, it shouldn't matter, but make sure that the declaration Dim colOptionButtons As Collection appears at the top of the userform code module after the Option Explicit statement but before any other procedure.

 

[Xalova]

In that case, simply replace...

If ctrl.Name Like "optbt[1-9]" Then

with

If LCase$(Left$(ctrl.Name, 3)) = "opt" Or LCase$(Left$(ctrl.Name, 4)) = "stat" Then

No, the Option Explicit statement only applies to it's respective module.


No, it shouldn't matter, but make sure that the declaration Dim colOptionButtons As Collection appears at the top of the userform code module after the Option Explicit statement but before any other procedure.

thank you for your answer. i get a runtime error 13: type mismatch. maybe it collides with my already existing code, maybe you can overlook it?

I have got alot of repeatable code there, thats why it seems to be that large, but it really isnt

Option Explicit

Dim colOptionButtons As Collection

Private Sub UserForm_Initialize()

    Set colOptionButtons = New Collection
 
    Dim ctrl As MSForms.Control
    Dim ob As clsOptionButton
    For Each ctrl In Me.Controls
        If LCase$(Left$(ctrl.Name, 3)) = "opt" Or LCase$(Left$(ctrl.Name, 4)) = "stat" Then
            Set ob = New clsOptionButton
            Set ob.optionButton = ctrl
            colOptionButtons.Add ob
        End If
    Next ctrl

End Sub

'enter date in textbox of 2 days ago
Private Sub BewVorgestern_Click()
    Me.dtBewerbung = Date - 2
    Me.Bewerbungsportal.SetFocus
End Sub

'enter date in textbox of 1 days ago
Private Sub BewGestern_Click()
    Me.dtBewerbung = Date - 1
    Me.Bewerbungsportal.SetFocus
End Sub

'enter date in textbox of today
Private Sub BewHeute_Click()
    Me.dtBewerbung = Date
    Me.Bewerbungsportal.SetFocus
End Sub

'enter date in textbox of 2 days ago
Private Sub UpVorgestern_Click()
    Me.dtLetztesUpdate = Date - 2
    Me.Kommentar.SetFocus
End Sub

'enter date in textbox of 1 day ago
Private Sub UpGestern_Click()
    Me.dtLetztesUpdate = Date - 1
    Me.Kommentar.SetFocus
End Sub

'enter date in textbox of today
Private Sub UpHeute_Click()
    Me.dtLetztesUpdate = Date
    Me.Kommentar.SetFocus
End Sub

'on enter setfocus on next optionbutton-set
Private Sub dtBewerbung_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        Me.Bewerbungsportal.SetFocus
    End If
End Sub

'on enter set fo us on next textbox
Private Sub dtLetztesUpdate_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        Me.Kommentar.SetFocus
    End If
End Sub

'activate optionbutton on text input
Private Sub DynButtonText_Change()
    Me.DynButton = True
End Sub

'write in public var
Private Sub EditExist_Click()
    Hide
    GetVal.Show
End Sub

'enter and clear datas, reset public var and exit form
Private Sub EnterExit_Click()
    Call EnterData
    IsEdit = False
    Me.Hide
End Sub

'enter and clear datas, reset public var. ready for new input
Private Sub EnterNew_Click()

    Call EnterData
    Call ClearData
    IsEdit = False

End Sub

Private Sub UserForm_Activate()
    
    'check if a existing row is to be edited or not
    If IsEdit = True Then
        'Set lrow = ThisWorkbook.Worksheets(1).ListObjects("bewerbungsliste").ListRows(ListVar)
        'fill form with existing datas
        With ThisWorkbook.Worksheets(1).ListObjects("bewerbungsliste").ListRows(ListVar)


            'Reihe 2, Firma
            Me.Firma.Value = .Range(2)
            
            'Reihe 3, Ort
            Me.Ort.Value = .Range(3)
            
            'Reihe 4, Datum der Bewerbung
            Me.dtBewerbung.Value = .Range(4)
            
            'Reihe 5, Bewerbungsportal
            If .Range(5).Value = "Bewerbung er Homepage" Then Me.optBewerbungHomepage.Value = True
            If .Range(5).Value = "Bewerbung per Telefon" Then Me.optBewerbungTelefon.Value = True
            If .Range(5).Value = "Direktbewerbung (E-Mail)" Then Me.optDirekt.Value = True
            If .Range(5).Value = "Get-In-Engineering" Then Me.optGetInEngineering.Value = True
            If .Range(5).Value = "Indeed" Then Me.optIndeed.Value = True
            If .Range(5).Value = "LinkedIn" Then Me.optLinkedIn.Value = True
            If .Range(5).Value = "StepStone" Then Me.optStepStone.Value = True
            If .Range(5).Value = "Xing" Then Me.optXing.Value = True
            
            'Reihe 6, Status der Bewerbung
            If .Range(6).Value = "absage" Then Me.StatAbsage.Value = True
            If .Range(6).Value = "zusage" Then Me.StatZusage.Value = True
            If .Range(6).Value = "Bewerbungsgespräch" Then Me.StatVG.Value = True
            If .Range(6).Value = "warte auf Antwort" Then Me.StatWarte.Value = True
            
            'Reihe 7, Datum vom letzten Update
            Me.dtLetztesUpdate.Value = .Range(7)
            
            'Reihe 9, Kommentar
            Me.Kommentar.Value = .Range(9)
            
        End With
    End If
    
    'proceed
    Me.Firma.SetFocus
End Sub

Private Sub EnterData()
    
    'check if existing row is to be edited and set lrow accordingly
    If IsEdit = False Then
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Worksheets(1)
        Dim tbl As ListObject
        Set tbl = ws.ListObjects("Bewerbungsliste")
        Set lrow = tbl.ListRows.Add
        Else
        Set lrow = ThisWorkbook.Worksheets(1).ListObjects("bewerbungsliste").ListRows(ListVar)
    End If

    With lrow
    
        'enter data

        'Reihe 2, Firma
        .Range(2) = Me.Firma.Value
        
        'Reihe 3, Ort
        .Range(3) = Me.Ort.Value
        
        'Reihe 4, Datum
        If Me.dtBewerbung = "" Or Not isdate(Me.dtBewerbung.Value) Then
        .Range(4) = Date
        Else
        Dim DatumBewerbung As Date
        DatumBewerbung = Me.dtBewerbung.Value
        .Range(4) = DatumBewerbung
        End If
        
        
        'Reihe 5, Portal
        If Me.optBewerbungHomepage.Value Then .Range(5) = "Bewerbung per Homepage"
        If Me.optBewerbungTelefon.Value Then .Range(5) = "Bewerbung per Telefon"
        If Me.optDirekt.Value Then .Range(5) = "Direktbewerbung (E-Mail)"
        If Me.optGetInEngineering.Value Then .Range(5) = "Get-In-Engineering"
        If Me.optIndeed.Value Then .Range(5) = "Indeed"
        If Me.optLinkedIn.Value Then .Range(5) = "LinkedIn"
        If Me.optStepStone.Value Then .Range(5) = "StepStone"
        If Me.optXing.Value Then .Range(5) = "Xing"
        
        'Reihe 6, Status
        If Me.StatAbsage.Value Then .Range(6) = "Absage"
        If Me.StatZusage.Value Then .Range(6) = "Zusage"
        If Me.StatVG.Value Then .Range(6) = "Bewerbungsgespräch"
        If Me.StatWarte.Value Then .Range(6) = "Warte auf Antwort"
        
        'Reihe 7, Letztes Update
        If isdate(Me.dtLetztesUpdate.Value) Then
        Dim DatumUpdate As Date
        DatumUpdate = Me.dtLetztesUpdate.Value
        .Range(7) = DatumUpdate
        
        End If
        
        'Reihe 8, Tage Seit Bewerbung
        .Range(8).NumberFormat = "general"
        
        'Reihe 9, Kommentar
        .Range(9) = Me.Kommentar.Value
        
    End With
    
    'reset public var
    IsEdit = False
    
    Call ClearData
End Sub

Private Sub ClearData()

    Me.Firma.Value = ""
    Me.Ort.Value = ""
    Me.dtBewerbung.Value = ""
    Me.dtLetztesUpdate.Value = ""
    Me.Kommentar.Value = ""
    Me.optStepStone.Value = True
    Me.DynButtonText.Value = ""
    Me.StatWarte.Value = True
    Me.Firma.SetFocus
    
    IsEdit = False
End Sub

and thats the code for the public variables:

Option Explicit

Public ListVar As String
Public IsEdit As Boolean
Public SuchMich As Integer

alternativly i could export the whole form for you, if you want?

 

[RoryA]

Are you sure you don't have any other controls that start with 'opt' or 'stat' that are not optionbuttons? Perhaps add a check for the type:

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "OptionButton" And (LCase$(Left$(ctrl.Name, 3)) = "opt" Or LCase$(Left$(ctrl.Name, 4)) = "stat") Then
            Set ob = New clsOptionButton
            Set ob.optionButton = ctrl
            colOptionButtons.Add ob
        End If
    Next ctrl

 

[Domenic]

Actually, since the comparison is case-sensitive...

TypeName(ctrl) = "OptionButton"

 

[Xalova]

at this point i dont know if i am doing anything wrong or if the code sadly just doesnt work. and now i dont know when the code should do what.
i have implemented the check for type from @RoryA . and it seems to check for something, but when i press enter on one of the optionbuttons nothing happens.

And yes, @RoryA , i do not have anything else with the prefix stat or opt. I have checked.

 

[Xalova]

@Domenic , is it supposed to be like that?

Set m_userForm = ob.Parent.Parent

i have set a stop at the following sub in the classmodule:

Private Sub m_optionButton_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    If KeyCode = 13 Then
        m_optionButton.Value = True
        m_userForm.Frame2.SetFocus
    End If
End Sub

at the if statement. It seems to never get to do something, even if i press enter (or any key for that matter) on a optionbutton in question

 

[RoryA]

i have implemented the check for type from @RoryA

Did you make the change that Domenic noted with my code (I have since edited it in case others come across this later)? The code works fine here.