Optimize dynamic creation of labels and their click events.

[bradyboyy88]

So my code allows to create a label dynamically (CreateLabel Sub) and dynamically remove labels (RemoveControls Sub) and the class module allows for the click event to occur for these dynamically created labels. The thing is I am using both collection and arrays to make this happen but I feel as though there has to be a way to get this just to the collection object and possibly reduce my code and make more efficient then having to redim everytime i create a new label and store the event process. I create over 8000 labels in a grid basically so its quite slow as you can imagine so anything to speed this up will really help. Thanks!

Class Module:

Option Explicit


Public WithEvents New_Label As MSForms.Label


Public Sub New_Label_Click()


Select Case Left(New_Label.Tag, 13)


    'Upload info
    Case "USR_Clickable"
        OpenFile New_Label.Caption
    
End Select


End Sub

Module:

Dim DynamicControl() As New DynamicControls
Public NewControls As New Collection



Public Sub CreateLabel(FRAME As MSForms.FRAME, Label_Caption As String, Top_Position As Integer, Left_Position As Integer, Width_Value As Integer, FixedWidth As Boolean, Height_Value As Double, TextAlignmentVar As Long, Visible_Value As Boolean, TagValue As String, UnderLineLink As Boolean, ColorChoice As Long, BackColorChoice As Long, Transparency As Boolean, FontBold As Boolean, Optional ByVal PictureImage As String)
    
    Dim Control As MSForms.Label
    
    Set Control = FRAME.Controls.Add("Forms.Label.1", , True)
       
    With Control
        .AutoSize = False
        .Width = Width_Value
        If FixedWidth Then
            .Caption = Label_Caption
            .AutoSize = False
        Else
            .Caption = Label_Caption
            .AutoSize = True
        End If
        .Left = Left_Position
        .Top = Top_Position
        .ForeColor = ColorChoice
        .BackColor = BackColorChoice
        .Height = Height_Value
        .Font.Underline = UnderLineLink
        .FontName = "Lucida Console"
        .Tag = TagValue
        If Transparency = True Then
            .BackStyle = fmBackStyleTransparent
        Else
            .BackColor = BackColorChoice
        End If
        .TextAlign = TextAlignmentVar
        .Visible = Visible_Value
        If FontBold = True Then .Font.Bold = True
        If Not PictureImage = "" Then
            .Picture = LoadPicture(ImagePathDirectory & PictureImage)
            .PicturePosition = fmPicturePositionCenter
        End If
    End With
    
    'Update Counter
    Control_Count = Control_Count + 1
    
    'Set the control to array event
    ReDim Preserve DynamicControl(1 To Control_Count)
    Set DynamicControl(Control_Count).New_Label = Control


    'Assign New Control to Collection
    NewControls.Add Control, Control.Name
    
End Sub


Public Sub RemoveControls()


    DoEvents
    Do While NewControls.count > 0
        MMCARMS.Controls.Remove NewControls.item(1).Name
        NewControls.Remove 1
    Loop
    
    Control_Count = 0
    
End Sub

 

[Kyle123]

Why not just use one collection?

 

[bradyboyy88]

How do you assign an event similar to what is done for the array, but to the collection? Can you provide an example or modify the code I provided above?

 

[bradyboyy88]

I added the following in place of the redim for the previous array and I draw an error for he remove function at line : MMCARMS.Controls.Remove NewControls.item(1).Name and says object doesnt support this option or method.

    Set DynamicControl = New DynamicControls
    Set DynamicControl.New_Label = Control
    NewControls.Add DynamicControl, Control.Name

 

[bradyboyy88]

Any ideas?