CreateEventProc failing when adding code for dynamically created button on UserForm

Question

I have been developing various reports and forms for data we are currently pulling from a legacy system. I have created a form that dynamically creates buttons and spaces them according to how many buttons have been created. My error comes in where I attempt to add _Click() functionality for each button, as the code will be unique for each button created. I have tried everything I can come up with and everything I have been able to find online, all to no avail. Through various different attempts, I have gotten to points where I have the buttons and the code populated in the UserForm CodeModule, but the _Click() event would not trigger from there. Any help would be greatly appreciated.

Private Sub CommandButton5_Click()

Dim lastrow As Long, i As Integer, numButtons As Integer, newButton As Control, lineNum As Long

numButtons = 1

With Sheets("Production Capacity")

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    .Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)

    For i = 4 To lastrow
        If i Mod 4 = 0 Then
            If .Cells(i, "D").Value > .Cells(2, "G").Value Then
                .Cells(i, "G").Interior.Color = RGB(255, 0, 0)
                Set newButton = Me.Controls.Add("Forms.CommandButton.1", "button" & numButtons, False)
                With newButton
                    .Width = 200
                    Select Case (numButtons Mod 3)
                        Case 0
                            .Left = 475
                        Case 1
                            .Left = 25
                        Case 2
                            .Left = 250
                    End Select
                    .Visible = True
                    .Height = 20
                    .Top = 60 + (Int((numButtons - 1) / 3) * 40)
                    .Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
                    .Font.Size = 10
                    .Font.Bold = True
                End With

                With ActiveWorkbook.VBProject.VBComponents("Class1").CodeModule
                    lineNum = .CreateEventProc("Click", "button" & numButtons) + 1 'This line is where the error occurs.
                    .InsertLines lineNum, _
                        "Dim lastrow as Long" & Chr(13) & _
                        "with Sheets(Sheets(""Production Capacity"").cells(1, ""A"").value)" & Chr(13) & _
                        ".ShowAllData" & Chr(13) & _
                        "lastrow = .Cells(Rows.Count, ""B"").End(xlUp).Row" & Chr(13) & _
                        ".Range(""A$6:$BQ$"" & lastrow).AutoFilter field:=30, Criteria1:=" & Chr(34) & ">=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "A").Value) & Chr(34) & ", Operator:=xlAnd, Criteria2:=" & Chr(34) & "<=" & Chr(34) & " & " & Chr(34) & DateValue(Sheets("Production Capacity").Cells(i, "B").Value) & Chr(34) & ", Operator:=xlAnd" & Chr(13) & _
                        "End With"
                End With
                numButtons = numButtons + 1
            End If

The error is 'Run-time error '57017': Event handler is invalid

on this line: lineNum = .CreateEventProc("Click", "button" & numButtons) + 1

Have you seen this one - https://stackoverflow.com/questions/566770/assign-on-click-vba-function-to-a-dynamically-created-button-on-excel-userform seems - 2 of the answers seem quite interesting. — Vityata, Apr 03 '18 at 14:55
I have tried both suggestions already, with no success. Creating the events within a class module was my latest attempt, but that restricts me to having each button doing the same thing, or to needing each button defined as a separate class. Changing my declarations to components of the VBIDE class yielded the same error at the same location as well. — Ryan M, Apr 03 '18 at 15:48
_"but that restricts me to having each button doing the same thing,"_: If I'm not wrong, the only difference in the code for all event handlers generated by your code resides in that `i` nested in `.Cells(i, "A").Value`. In this case you may have your class button _recreate_ that `i` value from the button caption — DisplayName, Apr 03 '18 at 16:03
@DisplayName Thank you! I posted my final solution below, and I am very grateful for the help. — Ryan M, Apr 03 '18 at 18:30

score 1 · Answer 1 · answered Apr 03 '18 at 18:29

Credit to @DisplayName! Thank you so much for helping me to simplify my solution and stop over-engineering it. My new Sub for the UserForm is as below:

Dim mColButtons As New Collection

Private Sub CommandButton5_Click()

Dim lastrow As Long, i As Integer, numButtons As Integer
Dim btnEvent As Class1
Dim ctl As MSForms.Control

numButtons = 1

With Sheets("Production Capacity")

    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

    .Range("A4:AD" & lastrow).Interior.Color = RGB(255, 255, 255)

    For i = 4 To lastrow
        If i Mod 4 = 0 Then
            If .Cells(i, "D").Value > .Cells(2, "G").Value Then
                .Cells(i, "G").Interior.Color = RGB(255, 0, 0)
                Set ctl = Me.Controls.Add("Forms.CommandButton.1")
                With ctl
                    .Width = 200
                    Select Case (numButtons Mod 3)
                        Case 0
                            .Left = 475
                        Case 1
                            .Left = 25
                        Case 2
                            .Left = 250
                    End Select
                    .Visible = True
                    .Height = 20
                    .Top = 60 + (Int((numButtons - 1) / 3) * 40)
                    .Caption = Sheets("Production Capacity").Cells(i, "A").Value & " - " & Sheets("Production Capacity").Cells(i, "B").Value & " DeptName"
                    .Font.Size = 10
                    .Font.Bold = True
                    .Name = "button" & numButtons
                End With

                Set btnEvent = New Class1
                Set btnEvent.btn = ctl
                Set btnEvent.frm = Me

                mColButtons.Add btnEvent

                numButtons = numButtons + 1
            End If

My Class Module now looks like this, and it simplifies all of the logic into a concise Select statement. Thank you again.

Public WithEvents btn As MSForms.CommandButton
Public frm As UserForm

Private Sub btn_click()

Dim startDate As String, endDate As String, department As String, lastrow As Long

startDate = Split(btn.Caption, " ")(0)
endDate = Split(btn.Caption, " ")(2)
department = Split(btn.Caption, " ")(3)

With Sheets(Sheets("Production Capacity").Cells(1, "A").Value)
    lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
    Select Case department
        Case "Veneering"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=21, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "MillMachining"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=30, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "BoxLine"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=39, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "Custom"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=48, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
        Case "Finishing"
            .ShowAllData
            .Range("A$6:$BQ$" & lastrow).AutoFilter field:=57, Criteria1:=">=" & DateValue(startDate), Operator:=xlAnd, Criteria2:="<=" & DateValue(endDate), Operator:=xlAnd
    End Select
End With

End Sub

CreateEventProc failing when adding code for dynamically created button on UserForm

1 Answers1