How can i control the with class module respective textboxes with keypress and change event ?

[NimishK]

Hello I would like
1. txtFrm5 to trigger the KeyPress Event with numerical values only
2. txtFrm7 to Automatically calculate discount of 10% in respective textbox Change event
i.e txtFrm7.value = txtFrm5.Value - (txtFrm5.Value*10/100)
3.TxtFrm7 should KeyAscii = 0 so no one enters the data

Here what happens all the textboxes with KeyPress event allows only numerical values
so How can i control the with class module the above mentioned respective textboxes with keypress and change event ?

https://www.dropbox.com/s/uqr00472qamkt3b/SpecificRequirementsTextBoxesClassEvent.xlsm?dl=0
In Class Module Class2AllTextboxes

Option Explicit
Public WithEvents AllTextboxesEvent As MSForms.TextBox

Private Sub AllTextboxesEvent_Change()
Dim i As Integer
Dim Ws As Worksheet

Set Ws = Worksheets("Sheet2")
Ws.Activate
If EditMode = True Then Exit Sub

For i = 1 To 7
   Ws.Cells(curRow, i).Value = UserForm2.Controls("txtFrm" & i).Value
Next i
End Sub

Private Sub AllTextboxesEvent_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
Select Case KeyAscii
    Case 48 To 57
        Exit Sub
        
    Case Else
        KeyAscii = 0
        MsgBox "Only numbers allowed.", 48, "Numbers only please."
        Exit Sub
    End Select

End Sub

in Module1

Option Explicit
Public row As Long
Public Ws As Worksheet
Public Const StartRow As Long = 2
Public curRow As Long, curRec As Integer
Public newUf1txtBxFrm As MSForms.TextBox
Public lablFrm2 As Control
Public EditMode As Boolean

inUserForm1

Option Explicit


Private Sub cmdUF2_Click()
  Dim Ws As Worksheet

EditMode = True
Load UserForm2
UserForm2.Show vbModeless
UserForm2.Caption = "Trial"
UserForm2.Top = 210
UserForm2.Left = 200


Set Ws = Worksheets("Sheet2")
Ws.Activate

GetRecord curRow
  EditMode = False
End Sub


Private Sub UserForm_Activate()
  UserForm1.Left = 245
End Sub

Private Sub UserForm_Initialize()
   Dim Ws As Worksheet
   Set Ws = Worksheets("Sheet2")
   Ws.Activate
curRec = 1
curRow = 2
Rows(curRow).Select

End Sub

Public Sub GetRecord(ByVal row As Long)
Dim Ws As Worksheet
Dim i As Integer
Set Ws = Worksheets("Sheet2")
    Ws.Activate
  If row < StartRow Then row = StartRow
For i = 1 To 6 '2
   UserForm2.Controls("txtFrm" & i).Value = Ws.Cells(row, i).Value
Next i
      Rows(row).Select
    curRec = curRow - 1
End Sub

In Userform2

Option Explicit
Public AllTextboxes As New Collection
Public Uf1txtBxFrm As New Class2AllTextboxes

Private Sub UserForm_Initialize()
   Call designForm2
End Sub

Public Sub designForm2()
Dim allTxtBxes As Class2AllTextboxes

Dim Ws As Worksheet
Set Ws = Worksheets("Sheet2")
Ws.Activate

Dim i As Integer
Dim x As Integer
Dim y As Integer

y = 10
x = 10

Set AllTextboxes = New Collection

For i = 1 To 7
Set allTxtBxes = New Class2AllTextboxes

Set newUf1txtBxFrm = UserForm2.Controls.Add("Forms.TextBox.1")  
Set allTxtBxes.AllTextboxesEvent = newUf1txtBxFrm
AllTextboxes.Add Item:=allTxtBxes

Set lablFrm2 = UserForm2.Controls.Add("Forms.Label.1")

 With lablFrm2
        .Name = "lblfrm2" '& nNames(i)
        .Height = 30
        .Width = 15 * 5
        .Left = x
        .Top = y
        .BackStyle = 0
        .Caption = Ws.Cells(1, i).Value & vbCrLf & "txtFrm" & i
  End With

  With newUf1txtBxFrm      'txtBxFrm2
        .Name = "txtFrm" & (i) '& nNames(i)
        .Height = 18
        .Width = 116
        .Left = x
        .Top = y + 30
        .Font.Name = "Calibri"
        .Font.Size = "11"
    End With
    
    x = x + 142

If i = 2 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If
    
If i = 4 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If

If i = 6 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If
Next i

End Sub

Thanks NimishK

 

[NimishK]

One Question
what is importance of NumericOnlyTbs(0 To 1) As NumericOnlyTbHnd
Set NumericOnlyTbs(0) = hnd
Set NumericOnlyTbs(1) = hnd
Fantastic
Yes Kyle123 Indeed Suceeded with combination. Really Excellent suggestion for creating more class modules and practically no confussion.

Except for watcher changed required as auto-updated
pressing keys in a particular textbox and in that particular textbox watcher chaged is fired. Frankly speaking it resembles as
For e.g
in tb5 you are just playing with keys on keyboard and value appears. Can we improve upon the same ?

Kindly note i've changed from tb to particularTxtbxEvent in all your 3 class modules for better clarity
code in Userform as follows

Private Sub UserForm_Initialize()
   Call designForm2
End Sub

Public Sub designForm2()

Dim hnd As Object
'Dim newUf1txtBxFrm As MSForms.TextBox ' in module publicliy defined
Dim allTxtBxes As Class2AllTextboxes

Dim Ws As Worksheet
Set Ws = Worksheets("Sheet2")
Ws.Activate

Dim i As Integer
Dim x As Integer
Dim y As Integer

y = 10
x = 10

Set AllTextboxes = New Collection

For i = 1 To 7
Set allTxtBxes = New Class2AllTextboxes

Set newUf1txtBxFrm = UserForm2.Controls.Add("Forms.TextBox.1")   '----> also correct
Set allTxtBxes.AllTextboxesEvent = newUf1txtBxFrm
AllTextboxes.Add Item:=allTxtBxes

Set lablFrm2 = UserForm2.Controls.Add("Forms.Label.1")

 With lablFrm2
        .Name = "lblfrm2" '& nNames(i)
        .Height = 15.75
        .Width = 15 * 5
        .Left = x
        .Top = y
        .BackStyle = 0
        .Caption = Sheet2.Cells(1, i).value & " txtFrm " & i
  End With

  With newUf1txtBxFrm      'txtBxFrm2
        .Name = "txtFrm" & (i) '& nNames(i)
        .Height = 18
        .Width = 116
        .Left = x
        .Top = y + 10
        .Font.Name = "Calibri"
        .Font.Size = "11"
    End With
    
    x = x + 142

If i = 2 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If
    
If i = 4 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If
    
If i = 6 Then
        x = 10 '15
        y = lablFrm2.Height + newUf1txtBxFrm.Height + y
End If
    
If i = 5 Then
    Set hnd = New NumericOnlyTbHnd
    Set hnd.particularTxtbxEvent = newUf1txtBxFrm   'Me.tb1
    Set NumericOnlyTbs(0) = hnd
End If
    
If i = 7 Then
    Set watcher = New EventSink
    Set watcher.particularTxtbxEvent = newUf1txtBxFrm 'Me.tb1
   End If
Next i

End Sub

Private Sub watcher_changed(value As Variant)
   
'Me.tb5 = value * 0.9
UserForm2.Controls("txtFrm" & 7).value = UserForm2.Controls("txtFrm" & 5) '* 10

End Sub

Thanks NimishK

 

[Kyle123]

One Question
what is importance of NumericOnlyTbs(0 To 1) As NumericOnlyTbHnd
Set NumericOnlyTbs(0) = hnd
Set NumericOnlyTbs(1) = hnd

Because in my example, we needed 2 event handlers, one for each textbox that should be numeric only and they need to be kept in scope.

 

[NimishK]

Kyle123
Everything Resolved as per desired. Automatic update values are seen
FYI just REMOVED 'RaiseEvent changed(tb.value) and added the following

Private Sub tb_Change()
    UserForm1.Controls("txtFrm" & 7).value = UserForm1.Controls("txtFrm" & 3).value 
End Sub

This thread has really made my life Simple
Thanks to you once more
Regards
NimishK

 

[Kyle123]

That’s not good coding for a couple of reasons, first of all your solution breaks encapsulation, secondly, you shouldn’t be using auto instanced versions of your Userform. You can’t guarantee that the instance you’re calling is actually the one displayed. I used the event to address both these issues

 

[NimishK]

That’s not good coding for a couple of reasons, first of all your solution breaks encapsulation, secondly, you shouldn’t be using auto instanced versions of your Userform. You can’t guarantee that the instance you’re calling is actually the one displayed. I used the event to address both these issues

OK
But I got my desired result

The Below did not Break Encapsulation.

Dim editMode as Boolean

Private Sub tb_Change()
    if editMode = True Then Exit Sub
    If tb.value = "" Then Exit Sub
    UserForm1.Controls("txtFrm" & 7).value = UserForm1.Controls("txtFrm" & 3).value 
End Sub

The following rather was not a user friendly to get the autoupdate value. so went for above.

Private Sub tb_Change()
    RaiseEvent changed(tb.value)
End Sub

If you have something different by not using Auto Instanced. Kindly let me know

 

[mikerickson]

You could do this with a single class object. A clsDiscountPair object

' in clsDiscountPair

Public WithEvents DataEntryTextBox As MSForms.TextBox
Public WithEvents DiscountTextBox As MSForms.TextBox
Const Discount As Double = 0.1

Private Sub DataEntryTextBox_Change()
    DiscountTextBox.Value = Val(DataEntryTextBox.Text) * (1 - Discount)
End Sub

Private Sub DataEntryTextBox_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = -KeyAscii * CLng(Chr(KeyAscii) Like "#")
    If KeyAscii = 0 Then Beep
End Sub

Private Sub DiscountTextBox_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    DataEntryTextBox.SetFocus
    KeyCode = 0
End Sub

And set up in the userform like

' in userform code module

Public Pair As clsDiscountPair

Private Sub UserForm_Initialize()
    Set Pair = New clsDiscountPair
    With Pair
        Set .DataEntryTextBox = TextBox1
        Set .DiscountTextBox = TextBox2
    End With
End Sub

or with multiple pairs, I'd use a Collection rather than an array

' in userform code module

Public Pairs As Collection

Private Sub UserForm_Initialize()
    Dim tempObject As clsDiscountPair
    Set Pairs = New Collection
    
    Set tempObject = New clsDiscountPair
    With tempObject
        Set .DataEntryTextBox = TextBox1
        Set .DiscountTextBox = TextBox2
    End With
    Pairs.Add Item:=tempObject
    
    Set tempObject = New clsDiscountPair
    With tempObject
        Set .DataEntryTextBox = TextBox3
        Set .DiscountTextBox = TextBox4
    End With
    Pairs.Add Item:=tempObject
    
    Set tempObject = Nothing
End Sub

 

[NimishK]

Hello Sir, MikeRickson

Thank you so much for your example where textboxes 1 to 4 are physically designed or placed on userform and your code works perfectly
And in my case when UserForm is loaded lets say 10 textboxes are created at Run time.

Lets Say txtfrm3, txtfrm5 created at run time are DataEntryTextbox as per your coding
Lets Say txtFrm4, TxtFrm6 created at run time are DiscountTexbox
and other textboxes are just normal ie txtrm1,2, 7,8,9,10

Really failed this time when I combined yours with Collection Logic and mine which is below
and I am unable to find the Data Member i.e txtFrm as code below marked in colour Red. Can you help me to correct ?

Public Pairs As Collection

Private Sub UserForm_Initialize()

Dim Ws As Worksheet
Set Ws = Worksheets("Sheet1")
Ws.Activate
Dim i As Integer
Dim x As Integer
Dim y As Integer

y = 10
x = 10

Dim tempObject As clsDiscountPair   
Set Pairs = New Collection     
Dim newTempObject As MSForms.TextBox
Dim lablFrm2 As Control

For i = 1 To 10
Set lablFrm2 = UserForm1.Controls.Add("Forms.Label.1")

 With lablFrm2
        .Name = "lblfrm2" '& nNames(i)
        .Height = 30
        .Width = 15 * 5
        .Left = x
        .Top = y
        .BackStyle = 0
        .Caption = Ws.Cells(1, i).Value & vbCrLf & "txtFrm" & i
  End With

Set tempObject = New clsDiscountPair  
Set newTempObject = UserForm1.Controls.Add("Forms.TextBox.1")
Pairs.Add Item:=newTempObject 'tempObject

With newTempObject
        .Name = "txtFrm" & (i) '& nNames(i)
        .Height = 18
        .Width = 116
        .Left = x
        .Top = y + 30
        .Font.Name = "Calibri"
        .Font.Size = "11"
End With
 
[COLOR=#ff0000]Set tempObject = New clsDiscountPair[/COLOR]
[COLOR=#ff0000]    With tempObject[/COLOR]
[COLOR=#ff0000]        Set .DataEntryTextBox = "txtFrm" & 3  [B]''''' Method or Data Member not Found[/B][/COLOR]
[COLOR=#ff0000]        Set .DiscountTextBox = "txtFrm" & 4  [B]''''TMethod or Data Member not Found[/B][/COLOR]
[COLOR=#ff0000]    End With[/COLOR]
[COLOR=#ff0000]    Pairs.Add Item:=tempObject[/COLOR]

x = x + 142

If i = 3 Then
  x = 10 
  y = lablFrm2.Height + 40 + y 
End If

If i = 6 Then
  x = 10 
  y = lablFrm2.Height + 40 + y 
End If

If i = 9 Then
  x = 10
  y = lablFrm2.Height + 40 + y 
End If

Next i
End Sub

Thankx NimishK

 

[mikerickson]

You could use code like this to apply it to newly created textboxes.

The intialize and placement would need to be customized to your desires.

' in userform
Dim Pairs As Collection

Private Sub UserForm_Click()
    Dim newPair As clsDiscountPair
    Dim i As Long
    
    For i = 1 To 3
        Set newPair = New clsDiscountPair
        With newPair
            Set .DataEntryTextBox = Me.Controls.Add("forms.TextBox.1")
            Set .DiscountTextBox = Me.Controls.Add("forms.TextBox.1")
            
            ' intialize and position created textboxes
            With .DataEntryTextBox
                .Top = 20
                .Left = i * .Width + 5
            End With
            .DiscountTextBox.Top = .DataEntryTextBox.Top + .DataEntryTextBox.Height + 1
            .DiscountTextBox.Left = .DataEntryTextBox.Left
            
        End With
        Pairs.Add Item:=newPair
    Next i
    Set newPair = Nothing
End Sub

Private Sub UserForm_Initialize()
    Set Pairs = New Collection
End Sub

 

[NimishK]

Sir, Thanks for the suggestion.
But this creates 3 pairs what i wanted was as per your Eg ie

if i = 2 ie textbox2 to be as DataEntryTextbox
and if i = 3 ie textbox as Discountbox
because there will be quite more normal textboxes when form loaded

Regards NimishK

 

[mikerickson]

Set the looping to as many textboxes as you want.

If you are only looking at 4 textboxes (2 pairs) I agree that creating them at runtime is not a good plan.