VBA - Add button on a userform: how to add its action

Question

In Excel, I'm adding buttons at runtime on a userform. How do I add these buttons actions to call a sub/function with parameters?

Here is how I currently add the button, which does not accept the 'OnAction' I add it

Dim MyR As Range, MyB As MSForms.Control

For i = 2 To ActiveSheet.UsedRange.Rows.Count
    If (Len(ActiveSheet.Cells(i, 1).Value) > 0) Then
        
        Set MyR = Range(ActiveSheet.Cells(i, 1), ActiveSheet.Cells(i, 1))
        Set MyB = UserForm1.Controls.Add("Forms.CommandButton.1")
        
        With MyB
            .Name = i
            .Left = 50
            .Top = 25 * i
    
            .Caption = "Caption text"
            
            .OnAction = "SomeFunction"
            .Parameter = i
        End With
        
    End If
Next i

above code fails on the .OnAction, I can't find how to programmatically add an action here with a parameter different for each button?

UPDATE

Below partially works, but only the last event that has been set works, so only the last button is working as intended

Dim i As Integer
    Dim MyB As MSForms.Control
    Dim btnEvent As MyCustomButton
    
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        If (Len(ActiveSheet.Cells(i, 1).Value) > 0) Then
            
            Set MyB = UserForm1.Controls.Add("Forms.CommandButton.1")
            
            With MyB
                .Name = ActiveSheet.Cells(i, 1).Value
                .Caption = ActiveSheet.Cells(i, 1).Value
                .Left = 10
                .Top = 25 * i
                .Width = 75
                .Height = 20
                .Tag = ActiveSheet.Cells(i, 1).Value
            End With
            
            Set btnEvent = New MyCustomButton
            Set btnEvent.btn = MyB
            Set btnEvent.frm = UserForm1
            
            If (i > 4) Then 'TODO delete this loop
                Exit For
            End If
            
        End If
    Next i
    
    UserForm1.Show

UPDATE 2

Ok, it seems events need to be stored somewhere for them to work if you create multiple of them in a loop. Storing them in a collection solves it for me. Found this in: Excel-VBA Capture all worksheet CommandButton click events to run universal code

Thanks @Maciej Los for your help

If anyone find this usefull, bellow is my working module:

Option Explicit

Sub tests()
    
    Dim i As Integer
    Dim MyB As MSForms.Control
    Dim btnEvent As MyCustomButton
    Dim colButtons As Collection
    
    Set colButtons = New Collection
    
    For i = 2 To ActiveSheet.UsedRange.Rows.Count
        If (Len(ActiveSheet.Cells(i, 1).Value) > 0) Then
            
            Set MyB = UserForm1.Controls.Add("Forms.CommandButton.1")
            
            With MyB
                .Name = ActiveSheet.Cells(i, 1).Value
                .Caption = ActiveSheet.Cells(i, 1).Value
                .Left = 10
                .Top = 25 * i
                .Width = 75
                .Height = 20
                .Tag = ActiveSheet.Cells(i, 1).Value
            End With
            
            Set btnEvent = New MyCustomButton
            Set btnEvent.btn = MyB
            Set btnEvent.frm = UserForm1
            colButtons.Add btnEvent
            
        End If
    Next i
    
    UserForm1.Show
    
End Sub

And the necessary class module:

Public WithEvents btn As MSForms.CommandButton
Public frm As UserForm

Private Sub btn_Click()
    Debug.Print (btn.Tag)
End Sub

A userform is needed too, named 'UserForm1' here.

Maciej Los · Accepted Answer · 2023-02-28T20:56:05.557

0

Take a look at here: Assign on-click VBA function to a dynamically created button on Excel Userform

There you'll find a very well explained example provided by @598Bubblehead. The difference is that you want to pass parameter. I'd suggest to use Tag property of a custom button.

All you need to do is to:

add class module and name it MyCustomButton

Public WithEvents btn As MSForms.CommandButton
Public frm As UserForm

Dim iCount As Long

Private Sub btn_Click()

  MsgBox "Parameter is: '" & btn.Tag & "'", vbInformation, "Welcome!"

End Sub

then use below code:

   Option Explicit

   Sub AddManyButtons()
       Dim ButCollection As New Collection
       Dim MyB As MSForms.Control
       Dim btnEvent As MyCustomButton
       Dim i As Integer

       For i = 1 To 5
           Set btnEvent = New MyCustomButton
           Set MyB = UserForm1.Controls.Add("Forms.CommandButton.1")
           With MyB
               .Name = "DynamicButton" & i
               .Caption = .Name
               .Left = 10
               .Top = 10 + ((i - 1) * 40)
               .Width = 75
               .Height = 32
               .Tag = .Name
           End With

           Set btnEvent.btn = MyB
           Set btnEvent.frm = UserForm1
           ButCollection.Add btnEvent
           Set MyB = Nothing
       Next i
       UserForm1.Show
   End Sub
End Sub

edited Feb 28 '23 at 20:56

answered Feb 27 '23 at 22:13

Maciej Los

8,468
1
20
35

Thanks @Maciej Los Though if I loop through this, only the last assigned event triggers the 'btn_Click' sub for example: ~~~ For i = 2 To ActiveSheet.UsedRange.Rows.Count Set MyB = UserForm1.Controls.Add("Forms.CommandButton.1") With MyB .Tag = ActiveSheet.Cells(i, 1).Value End With Set btnEvent = New MyCustomButton Set btnEvent.btn = MyB Set btnEvent.frm = UserForm1 Next i ~~~ – Garlik85 Feb 28 '23 at 20:30
You have to create as many button as many parameters you want to pass. Or, you have to pass a string then parse this string into parameters. – Maciej Los Feb 28 '23 at 20:35
Sorry, I was not clear enough, I added an update in the original post with the code used. The problem is that only the last button works. Like if only 1 event is saved. Sorry, I have never worked with events in VBA before and feel I am missing something – Garlik85 Feb 28 '23 at 20:38
Aha, found the same solution elsewhere at the same time and edited my original post too. Thanks a lot for your help! Cheers! – Garlik85 Feb 28 '23 at 20:57

VBA - Add button on a userform: how to add its action

1 Answers1