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

NimishK

Well-known Member
Joined
Sep 4, 2015
Messages
688
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
Code:
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
Code:
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
Code:
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
Code:
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
 
Last edited:
Kyle123 you are right. Now i agree after going into depth.
but now no option for me but i have rub the textbox to get value. :laugh:

But following when addition is done it reads the values of respective textboxes instead of summing up
FYI Multiplication does work perfectly but summing the values no success. How can i overcome this
Code:
Private Sub watcher_changed(value As Variant)
    userform1.Controls("txtFrm" & 7).value = Userform1.Controls("txtFrm" & 3).value + Userform1.Controls("txtFrm" & 5).value
End sub

[B]in EventSink class module[/B]

Private Sub tb_Change()
    RaiseEvent changed(tb.value)
End sub
you enter value in txtfrm3 as 50 and txtfrm5 as 50
Display is like 5050 instead of 100
Tried all the possible methods
I dont understand simple addition can't work
 
Last edited:
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
The .Value of a text box is a string not a number. Excel "helpfuly" interprets + to mean concatenation between strings. To add, you need to convert it to numbers
Code:
userform1.Controls("txtFrm" & 7).value = Val(Userform1.Controls("txtFrm" & 3).value) + Val(Userform1.Controls("txtFrm" & 5).value)
 
Last edited:
Upvote 0
Ok sir Got it . the same thing was displayed in your DiscountText . I really missed it. Thanks
 
Upvote 0
Sir MikeRickson

Posting the code herwith, Require your guidance

For few Selected textboxes i want Only Numeric KeyPress, For all Textboxes normal change event, and few textboxes only Read.
Which i am trying for last couple of days but no success. the problem is mentioned below

I have made one class for 3 keyevents
Code is for your reference

Problem
1. I have been able to execute class for partiuclar textbox for numeric, and Read Event but if i select another textbox then it executes
for the Textbox "i" . which is the next highest number in the loop. I dont understand why and it does not execute for the previous boxes or
the textboxes selcted in IF EndIf statements

For....
If i = 2 -------------> Textbox No 2
it executes OK
End if

but

If i = 4 -------------> Textbox No 4
it executes OK but then
does not execute for textbox 2 or i = 2
End if

The above problem also lies same with 3 different class with Each Event respectively which was also tried.

in Class Module ClassNumericRead
Code:
Option Explicit

Public WithEvents AllTextboxesEvent As MSForms.TextBox
Public WithEvents NumericallTextboxesEvent As MSForms.TextBox
Public WithEvents ReadallTextboxesEvent As MSForms.TextBox
Public WithEvents particularTxtbxCalcEvent As MSForms.TextBox

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

Private Sub particularTxtbxCalcEvent_Change()
   RaiseEvent changed(particularTxtbxCalcEvent.value)
End Sub

Private Sub ReadallTextboxesEvent_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    KeyAscii = 0
    MsgBox "No entry", vbCritical
End Sub

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

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

For i = 1 To 10
   Ws.Cells(curRow, i).value = UserForm1.Controls("txtuf1Frm" & i).value
Next i

End Sub

in Userform1
Code:
Option Explicit
Public AllTextboxes As New Collection
Public NumericAllTextBoxes As New Collection
Public ReadAllTextBoxes As New Collection
Public ParticularCalcTextboxes As New Collection

Private Sub UserForm_Initialize()
  Call DesignForm
End Sub

Public Sub DesignForm()

Dim allTxtBxes As ClassNumericRead
Dim allNumTxtBxes As ClassNumericRead
Dim allReadTxtBxes As ClassNumericRead
Dim allparticularCalcTxtBxes As ClassNumericRead

x = 10
y = 10

For i = 1 To 10
      Set uF1frmTxtBx = Controls.Add("forms.textbox.1")
      
      Set lablFrm1 = UserForm1.Controls.Add("Forms.Label.1")
          With lablFrm1
              .Name = "lblfrm1" '& nNames(i)
              .Height = 18 '18  '30
              .Width = 126 '15 * 5
              .Left = x
              .Top = y
          End With

     With uF1frmTxtBx
          .Name = "txtuf1Frm" & i
          .Top = y + 20
          .Height = 18
          .Left = x
          .Width = 116
          .Font.Size = "11"
          .Font.Name = "Calibri"
     End With
x = x + 142
[COLOR=#ff0000]
If i = 2 Then
   Set allNumTxtBxes.NumericallTextboxesEvent = uF1frmTxtBx
   NumericAllTextBoxes.Add Item:=allNumTxtBxes
End If
[/COLOR]

If i = 3 Then
   Set allReadTxtBxes.ReadallTextboxesEvent = uF1frmTxtBx
   ReadAllTextBoxes.Add Item:=allReadTxtBxes
End If

[COLOR=#ff0000]If i = 4 Then
   Set allNumTxtBxes.NumericallTextboxesEvent = uF1frmTxtBx
   NumericAllTextBoxes.Add Item:=allNumTxtBxes
End If
[/COLOR]
End Sub

In Module1
Code:
Public uF1frmTxtBx As MSForms.TextBox
Public lablFrm1 As MSForms.Label
Public curRow As Long, row as Long, curRec As Integer
Public Const StartRow As Long = 2
Public Ws As Worksheet

Sir Your guidance will be appreciated in the above coding structure.
Thank you
NimishK
 
Last edited:
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top