Call same SUB from multiple buttons in VBA

Question

I have multiple buttons (active x) on a spreadhseet in same column but different rows. These buttons capture the start time of an activity. If button 1 is pressed cell next to it should be populated by current time. If button 2 is pressed cell next to it should be populated by current time. and so on.....

I have written a SUB in VBA as follows:

Private Sub StartTimer_Click()
    Range("I4").Value = Now
End Sub

I do not want to repeat this code for each button action. Please let me know how it can be made dynamic.

Answer 1

Create a standard module and put the procedure in there.

While it is possible to share a procedure in a private module, it's best practice to put any shared procedures in a shared module.

In the VBA Editor click Insert > Module,

Paste into there, and give it a unique name. Using your example you could do something like:

Public Sub SetTimeValue()
    Range("I4").Value = Now 
End Sub

...then call this public stub from your other one, like:

Private Sub StartTimer_Click()
    SetTimeValue
End Sub

...and from any other locations where you need to call your code.

I assume that you have more than one line of code for the actual procedure you're concerned about, otherwise copying it repeatedly isn't really a concern.

---

More Information:

• MSDN : Understanding Scope and Visibility
• Office Support : Scope of variables in Visual Basic for Applications
• Chip Pearson : Understanding Scope Of Variables And Procedures
• PowerSpreadsheets : Excel VBA Sub Procedures: The Complete Tutorial
• MVP : Cut out repetition using subs and functions with arguments

Answer 2

A simple WithEvents example:

in a class (named clsButtons):

Private WithEvents Bt As MSForms.CommandButton

Property Set obj(b As MSForms.CommandButton)
Set Bt = b
End Property

Private Sub Bt_Click()
'uses the right of the name of the CommandButton
Cells(1 + Right(Bt.Name, 1) * 3, 9).Value = Now
End Sub

In the sheetcode (the one with the buttons):

Dim myButtons  As Collection
Private Sub Worksheet_Activate()

    Dim ctl As OLEObject
    Dim ButtonClass As clsButtons
    Set myButtons = New Collection

    For Each ctl In Sheet1.OLEObjects
            If ctl.progID = "Forms.CommandButton.1" Then
               Set ButtonClass = New clsButtons
               Set ButtonClass.obj = ctl.Object
               myButtons.Add ButtonClass
        End If
    Next ctl

End Sub