Shorter way to create multiple identical Event Procedures?

[Sam Kuo]

Hi all,

I have 10 textboxes (namely txtPost1, txtPost2, ..., txtPost10) which I want
to assign the event procedure below to. I just wonder if there might be a
short way to do than copy and paste the code 10 times?

Private Sub txtPost1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Update work duration (by calling macro UpdateDuration)
UpdateDuration ("Post")
End Sub

 

[Jon Peltier]

John Walkenbach shows here how to do this for buttons. Same idea,

http://www.j-walk.com/ss/excel/tips/tip44.htm

- Jon

 

[Sam Kuo]

Thanks Jon. Below is my attempt, but I don't know what the error means and
how to tackle it. Do you mind have a look and give it a twig please? Many
thanks!

' Below is saved in Forms/frmUSLE:
'Compile error: Object does not source automation events -->
Public WithEvents txtEarthwksGroup As TextBox

Private Sub txtEarthwksGroup_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Update work duration (by calling macro UpdateDuration)
UpdateDuration ("Earthwks")
End Sub

' Below is saved in Class Modules/Class1:
Option Explicit
Dim TextBoxes() As New Class1

Private Sub RuntxtEarthwksGroup()
Dim ctrl As Controls
Dim CatchmentCount As Integer

CatchmentCount = 1
For Each ctl In frmUSLE.Controls
If TypeName(ctrl) = "TextBox" Then
If ctrl.Name = "txtEarthwks" & CatchmentCount Then
CatchmentCount = CatchmentCount + 1
ReDim Preserve TextBoxes(1 To CatchmentCount)
Set TextBoxes(CatchmentCount).txtEarthwksGroup = ctrl
End If
End If
Next ctrl
End Sub

 

[Sam Kuo]

Sorry, some corrections, but error still occurs...

' Below is saved in Class1
'Compile error: Object does not source automation events -->
Public WithEvents txtEarthwksGroup As TextBox

Private Sub txtEarthwksGroup_Exit(ByVal Cancel As MSForms.ReturnBoolean)
' Update work duration (by calling sub UpdateDuration in Module1)
UpdateDuration ("Earthwks")
End Sub


' Below is saved in Module1
Option Explicit

Dim TextBoxes() As New Class1
Sub RuntxtEarthwksGroup()
Dim ctrl As Controls
Dim CatchmentCount As Integer

CatchmentCount = 0
For Each ctl In frmUSLE.Controls
If TypeName(ctrl) = "TextBox" Then
If ctrl.Name = "txtEarthwks" & CatchmentCount Then
CatchmentCount = CatchmentCount + 1
ReDim Preserve TextBoxes(1 To CatchmentCount)
Set TextBoxes(CatchmentCount).txtEarthwksGroup = ctrl
End If
End If
Next ctrl
End Sub


Sub USLE()
RuntxtEarthwksGroup
' Show the userform frmUSLE
frmUSLE.Show
End Sub

 

[Jon Peltier]

The VBA compiler thinks you mean a worksheet textbox. Change to this:

Public WithEvents txtEarthwksGroup As MSForms.TextBox

- Jon

 

[Peter T]

You do need to qualify "TextBox" with MSForms as Jon suggests. However even
after doing that there are four textbox events that are not exposed to
WithEvents
Enter, Exit, BeforeUpdate, AfterUpdate

So you may have to think a different approach for your Exit event.

Also, after declaring your WithEvents object in the class module, select
your object in the middle dropdown and required event(s) from the right
dropdown

Regards,
Peter T

 

[Sam Kuo]

Thanks Jon.

Thanks Peter for your further help. But I'm not clear about "select object
in the middle dropdown and required event(s) from the right dropdown". Where
are the middle and right dropdowns?

Sam

 

[Jon Peltier]

The left and right dropdowns (no middle) are in the top section of the class
module code window.

- Jon