Userform with code-generated controls - Label captions not updating

[TopCatt]

Hi - I have a userform with lots of combo, text, and label boxes generated at runtime (a row of 30 or so controls is generated for each row of an order, might be 1 or 10 of them). The controls are generated in the userform code module, the events handlers for the generated controls are in a class module, and some other functions are in a seperate code module. This is the first time I've used a class module to handle events for controls like this, so it may well have something to do with that.

The problem I have is that changes to the captions of generated label controls from the normal code module do not update to the screen. Back in the userform module (e.g. if some fixed control is changed) you can see that the value of the caption has changed (he value behind it definitely changes, it starts at zero, and you can output in a msgbox that it's changed, colors change based on its value etc.), but the label caption on the userform stays as zero; me.repaint doesn't cause it to refresh either. I've fiddled around a bit with DoEvents but I don't really understand it and that hasn't helped. I don't have any of the application updating/calculating/events etc. switched off. All the other color changing events etc. happen fine, just not the updating of the label captions.

Is there some particular way of getting a userform label caption to update? I've put the relevant (I think) code that I'm using below, I could post a spreadsheet with all the code + userform layout if that would help. The line that's the problem (right by the end of the last code section) is

AddOrdersForm.Controls("PallTotLab" & Rw).Caption = PallTot

I generate the controls as follows (I've hardcoded some variables + removed some of the combobox set up; the userform is called AddOrdersForm:

Option Explicit

Option Base 1

Dim PalletBoxArray() As New Class1, TextBoxArray() As New Class1, LabelArray() As New Class1


Private Sub UserForm_Initialize()

' various things

Call CreateProductFormBoxes(5)

End Sub

Sub CreateProductFormBoxes(DepNum As Long)

Dim NumProds As Long, i As Long, RowTop As Long, j As Long, PalNumber As Long, CBox As MSForms.ComboBox, TransString As String, _
TBox As MSForms.TextBox, LBox As MSForms.Label

NumProds = DepNum
PalNumber = 26

ReDim TextBoxArray(1 To (NumProds * 2))
ReDim LabelArray(1 To NumProds)

For i = 1 To NumProds
 
 RowTop = 30 + i * 30

 Set TBox = AddOrdersForm.Controls.Add("Forms.TextBox.1", "CasesBox" & i, True)
 
 With TBox
  .Top = RowTop
  .Left = 396
  .Height = 24
  .Width = 42
  .Font.Size = 10
  
  Set TextBoxArray(NumProds + i).TextBoxEvents = TBox
  
 End With
 
 For j = 1 To PalNumber
  Set TBox = AddOrdersForm.Controls.Add("Forms.TextBox.1", "PalletsBox" & i & "-" & j, True)
  With TBox
   .Top = RowTop
   .Left = 418 + (30 * j)
   .Height = 24
   .Width = 24
   .Font.Size = 10
   
  Set PalletBoxArray(((i - 1) * PalNumber) + j).TextBoxEvents = TBox
   
   
   
  End With
  
  Set LBox = AddOrdersForm.Controls.Add("Forms.Label.1", "PallTotLab" & i, True)
  
  With LBox
   .Top = RowTop
   .Left = 454 + (30 * PalNumber)
   .Height = 24
   .Width = 36
   .Font.Size = 10
   .Caption = 0
  End With
  
  Set LabelArray(i).LabelEvents = LBox

 Next j
 
Next i

The event handling for these is in a class module (GreenRow is a global Boolean, the Extract functions just take the name and row of the control from its name, UpdateTotals is where the caption should be changed, ):

Option Explicit

Public WithEvents ComboEvents As MSForms.ComboBox
Public WithEvents TextBoxEvents As MSForms.TextBox
Public WithEvents LabelEvents As MSForms.Label

Private Sub TextBoxEvents_change()

Dim BoxName As String, BoxRow As Long, L As Long

If Not IsNumeric(TextBoxEvents.Value) Then
 L = Len(TextBoxEvents.Value)
 If L = 1 Then
  TextBoxEvents.Value = ""
 ElseIf L > 1 Then
  TextBoxEvents.Value = Left(TextBoxEvents.Value, L - 1)
 End If
End If

BoxName = ExtractFormName(TextBoxEvents.Name)
BoxRow = ExtractFormRow(TextBoxEvents.Name)

GreenRow = False



If BoxName = "PalletsBox" Or BoxName = "CasesBox" Then
 Call UpdateTotals(BoxRow)
Else
 GoTo AbortSub
End If

If TextBoxEvents.Value = 0 Or TextBoxEvents.Value = "" Then
 TextBoxEvents.BackColor = vbWhite
Else
 TextBoxEvents.BackColor = vbYellow
End If

If GreenRow = True Then
 Call ChangeRowFill(BoxRow, vbGreen)
Else
 Call ChangeRowFill(BoxRow, vbYellow)
End If

AbortSub:

End Sub

And the functions called from the class module are in a seperate code module:

Option Explicit

Public GreenRow As Boolean, EnEvents As Boolean


Public Function ExtractFormName(ExN As String) As String

Dim TempString As String, DashPos As Long, CheckDig As String

DashPos = InStr(1, ExN, "-")

If DashPos > 0 Then ' remove - and the number afterwards
 TempString = Left(ExN, DashPos - 1)
Else
 TempString = ExN
End If



Do While IsNumeric(Right(TempString, 1))
 TempString = Left(TempString, Len(TempString) - 1)
Loop

ExtractFormName = TempString

End Function

Public Function ExtractFormRow(ExN As String) As Long

Dim TempString As String, AnsString As String, DashPos As Long

DashPos = InStr(1, ExN, "-")

If DashPos > 0 Then ' remove - and the number afterwards
 TempString = Left(ExN, DashPos - 1)
Else
 TempString = ExN
End If

Do While IsNumeric(Right(TempString, 1))
 AnsString = Right(TempString, 1) & AnsString
 TempString = Left(TempString, Len(TempString) - 1)
Loop

ExtractFormRow = AnsString

End Function

Public Sub ChangeRowFill(Rw As Long, Clr As Long)

Dim PalNumber As Long, i As Long

 PalNumber = 26

If  AddOrdersForm.Controls("CasesBox" & Rw).Value <> "" And  AddOrdersForm.Controls("CasesBox" & Rw).Value <> 0 Then
 AddOrdersForm.Controls("CasesBox" & Rw).BackColor = Clr
End If

If  AddOrdersForm.Controls("PallTotLab" & Rw).Caption <> "" And  AddOrdersForm.Controls("PallTotLab" & Rw).Caption <> 0 Then
 AddOrdersForm.Controls("PallTotLab" & Rw).BackColor = Clr
End If

For i = 1 To PalNumber
 If  AddOrdersForm.Controls("PalletsBox" & Rw & "-" & i).Value  <> "" And AddOrdersForm.Controls("PalletsBox" & Rw & "-"  & i).Value <> 0 Then
  AddOrdersForm.Controls("PalletsBox" & Rw & "-" & i).BackColor = Clr
 End If
Next i

End Sub

Public Sub UpdateTotals(Rw As Long)

Dim PallTot As Double, Order As Double, PalNumber As Long, i As Long

PalNumber = 26

If AddOrdersForm.Controls("CasesBox" & Rw).Value = "" Then
 Order = 0
Else
 Order = AddOrdersForm.Controls("CasesBox" & Rw).Value
End If

PallTot = 0

For i = 1 To PalNumber
 If AddOrdersForm.Controls("PalletsBox" & Rw & "-" & i).Value <> "" Then
  PallTot = PallTot + AddOrdersForm.Controls("PalletsBox" & Rw & "-" & i).Value
 End If
Next i

AddOrdersForm.Controls("PallTotLab" & Rw).Caption = PallTot

If PallTot = Order Then
 GreenRow = True
Else
 GreenRow = False
End If

End Sub

Thanks,

TC

 

[AddinBox_Tsunoda]

Hi, TopCatt

> The problem I have is that changes to the captions of generated label controls
> from the normal code module do not update to the screen.
Because a description position of [ Next j] is wrong,
26 labels stack it on the same position and are made.

-- AddOrdersForm module --

  For j = 1 To PalNumber
    Set TBox = AddOrdersForm.Controls.Add("Forms.TextBox.1", "PalletsBox" & i & "-" & j, True)
    With TBox
      .Top = RowTop
      .Left = 418 + (30 * j)
      .Height = 24
      .Width = 24
      .Font.Size = 10
      Set PalletBoxArray(((i - 1) * PalNumber) + j).TextBoxEvents = TBox
    End With

[ [B]Next j[/B] ] .... [COLOR=#ff0000]Right position[/COLOR]

  Set LBox = AddOrdersForm.Controls.Add("Forms.Label.1", "PallTotLab" & i, True)
  With LBox
    .Top = RowTop
    .Left = 454 + (30 * PalNumber)
    .Height = 24
    .Width = 36
    .Font.Size = 10
    .Caption = 0
  End With
  Set LabelArray(i).LabelEvents = LBox

  [B]Next j[/B]  ... [COLOR=#ff0000]Current wrong position[/COLOR]
 
Next i

After seeing macro, there are some points that should be improved.

(1) There is no ReDim statement of PalletBoxArray in AddOrdersForm module.
And you assume PalletBoxArray one dimension array, but should do it
in two-dimensional array.

ReDim PalletBoxArray(1 To NumProds, 1 to 26)

> Set PalletBoxArray(((i - 1) * PalNumber) + j).TextBoxEvents = TBox
Set PalletBoxArray(i, j).TextBoxEvents = TBox

In addition, I do not understand a reason leaving 5 from 1 of TextBoxArray as far as I saw macro.



(2) You should avoid appointing New keyword in Dim statement.
Memory assigned to the object variable is not released
even if you carry out [object variable =Nothing] at the time of the end
when Dim statement has New keyword.
If I say exactly,
the memory which was assigned so far is released by a set of Nothing,
but memory is assigned newly by action in itself of the set of Nothing.

> Dim TextBoxArray() As New Class1
> ReDim TextBoxArray(1 To (NumProds * 2))
> For i = 1 To NumProds
>     Set TextBoxArray(NumProds + i).TextBoxEvents = TBox

Dim TextBoxArray() As Class1
ReDim TextBoxArray(1 To (NumProds * 2))
For i = 1 To NumProds
     Set TextBoxArray(NumProds + i) = New Class1
     Set TextBoxArray(NumProds + i).TextBoxEvents = TBox

It release object variables in the last (Terminate event).
The object array variable can release all elements in the array by Erase statement in a lump.

Erase PalletBoxArray
Erase TextBoxArray
Erase LabelArray

(3) If you prepare for Row and Column in Class1,
ExtractFormName and ExtractFormRow will be unnecessary.
(You should assume it a property, but do not mind even a public variable.)
If Type prepares together, it will become easier.

-- AddOrdersForm module --
Set TextBoxArray(NumProds + i) = New Class1
With TextBoxArray(NumProds + i)
    Set .TextBoxEvents = TBox
    .Type = "CasesBox"
    .Row = i
    .Column = 1  'fixed with 1
End With



Set PalletBoxArray(i, j) = New Class1
With PalletBoxArray(i, j)
    Set .TextBoxEvents = TBox
    .Type = "PalletsBox"
    .Row = i
    .Column = j
End With


-- Class1 module --
Public WithEvents ComboEvents As MSForms.ComboBox
Public WithEvents TextBoxEvents As MSForms.TextBox
Public WithEvents LabelEvents As MSForms.Label

Public Type As String
Public Row As Integer
Public Column As Integer

Private Sub TextBoxEvents_Change()
    GreenRow = False

    Select Case Me.Type
      Case "PalletsBox", "CasesBox"
        Call UpdateTotals(Me.Row)

        With Me.TextBoxEvents
          If (.Value = "") Then
            .BackColor = vbWhite
          ElseIf IsNumeric(.Value) Then
            If (CLng(.Value) = 0) Then
              .BackColor = vbWhite
            Else
              .BackColor = vbYellow
            End If
          Else
            .BackColor = vbYellow
          End If
        End With

        If (GreenRow = True) Then
          Call ChangeRowFill(Me.Row, vbGreen)
        Else
          Call ChangeRowFill(Me.Row, vbYellow)
        End If
      Case Else
    End Select
End Sub