VBA: Dynamically created ComboBox with assigned event on change

Question

I found this and tried to apply the code from the most voted answer to my project. What I want to do is to create comboboxes dynamically and assign a function on change event for each one of those. Here is how I tried to do it based on the other thread.

Here is code on my worksheet where the button locates (Sheet1):

Option Explicit

Dim cmdArray() As New Class1

Private Sub CommandButton2_Click()

    Dim ctop#, cleft#, cht#, cwdth#
    
    Dim sht1 As Worksheet
    Dim sht2 As Worksheet
    
    Dim listfillCell As Range
    
    Dim ColumnLetter As String
    Dim StartAddress As String

    Dim i As Long
    
    Dim ctl_Command As OLEObject
    
    Set sht1 = ThisWorkbook.Worksheets("Sheet1")
    Set sht2 = ThisWorkbook.Worksheets("Sheet2")
        
        For i = 1 To 5
            
            Set listfillCell = sht2.Cells(1, i)
            ColumnLetter = "$" & Split(listfillCell.Address, "$")(1) & "$"
            StartAddress = listfillCell.Address
                
                With sht1.Range("J" & i + 8)
                ctop = .Top
                cleft = .Left
                cht = .Height
                cwdth = .Width
                End With
                
                With sht1
                Set ctl_Command = .OLEObjects.Add(ClassType:="Forms.ComboBox.1", Left:=cleft, Top:=ctop, Width:=cwdth, Height:=cht)
                End With
                
                ctl_Command.Placement = xlMoveAndSize
                ctl_Command.Select
                    
                    With Selection
                        .ListFillRange = ("Sheet2!" & StartAddress & ":" & ColumnLetter) & sht2.Range(listfillCell.Address).End(xlDown).Row
                        .LinkedCell = Cells((i + 8), 6).Address(0, 0)
                        .Object.FontSize = 14
                        .Object.BackColor = RGB(226, 239, 218)
                    End With
                
                ReDim Preserve cmdArray(1 To i)
                
                Set cmdArray(i).CmdEvents = ctl_Command
                Set ctl_Command = Nothing
        
        Next

End Sub

And here is the code in my class module:

Option Explicit

Public WithEvents CmdEvents As MSForms.ComboBox

Private Sub CmdEvents_Change()

    MsgBox "Hello Word"

End Sub

So now it goes up to creating a single combobox and then breaks after line " ReDim Preserve cmdArray(1 To i) " with " Run-time error '13': Type mismatch ". What might be wrong with this?

Answer 1

Two issues. Here's the first:

Dim cmdArray() As New Class1

You probably mean:

Dim cmdArray() as Class1

And here's the second issue:

ReDim Preserve cmdArray(1 To i)

This probably shouldn't be in the loop. Instead, put it above your for loop as

ReDim cmdArray(5)