Home > database >  Using excel VBA, why does my sub appear to run twice using Application.run?
Using excel VBA, why does my sub appear to run twice using Application.run?

Time:10-15

In my spreadsheet cell I have a cell with the formula

=RunMacro("sample_macro('first';'second')", "double click me")

In my module I have

Option Explicit

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    
    RunMacro = display

End Function

Public Sub sample_macro(one As String, two As String)
    MsgBox one
    MsgBox two
End Sub

In my sheet code, I have

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
     ' Prevent default double-click action
     Cancel = True
     ' call function
     Application.run Replace(Replace(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";", ","), "'", """")
 End If
    
End Sub

As desired, the cell displays "Double click me."

As desired, when the cell is double-clicked, the sample_macro is executed.

As desired, clicking any other cell simply goes into edit mode.

Not desired or understood: I get four message boxes. "first", "second", "first", "second".

Can anybody see a reason why?

Rory and Absinthe suggest correcting the syntax on the Application.run statement. Ike points out that I must pass macro name and parameters separately when dynamic. Thank you all!

Here is what I ended up with. I think it is a nice way to dynamically call an excel macro by double-clicking on a cell containing the macro name and parameters to be called.

In the cells, use a UDF with macro and parameters as the first element delimited with semicolons and the text to display as the second element. Something like these

=RunMacro("sample_macro2;first;second", "run a macro with two parameters")
=RunMacro("sample_macro1;first", "run a macro with one parameter")
=RunMacro("sample_macro0", "run a macro with no parameters")

In the code for the sheet, have the following

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
    Dim myparams As Variant
    Dim mymacro As String
    Dim i As Integer
    ' Prevent default double-click action
    Cancel = True
    ' preparemacro name and parameters to be provided seperately to run function
    myparams = Split(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";")
    mymacro = myparams(0)
    ' stip off first element now saved in string
    If UBound(myparams) > 1 Then
        For i = 1 To UBound(myparams)
            myparams(i - 1) = myparams(i)
        Next i
        ReDim Preserve myparams(UBound(myparams) - 1)
        Application.Run mymacro, myparams
    ElseIf UBound(myparams) = 1 Then
        Application.Run mymacro, myparams(1)
    Else
        Application.Run mymacro
    End If
    
 End If
    
End Sub

Then the macro to be called, if it has two or more parameters, must receive them as an array. Here is the contents of the module. The UDF is, of course, required. The others are samples.

Option Explicit

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    ' this is the UDF.  It permits us to hold the name of the macro and the parameteres (if any) in the cell
    ' but it merely displays the display text unless/until double-clicked
    RunMacro = display
End Function

Public Sub sample_macro2(arrParameter As Variant)
    ' macros with 2 or more parameters must receive them as an array
    Dim i As Long
    For i = LBound(arrParameter) To UBound(arrParameter)
        MsgBox arrParameter(i)
    Next
End Sub

Public Sub sample_macro1(myparam As Variant)
    MsgBox myparam
End Sub

Public Sub sample_macro0()
    MsgBox "you've reached two"
End Sub


CodePudding user response:

This works - but you have to pass the parameters as array

Application.Run is called by the macro - Arg1 - syntax.

worksheet module

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
     ' Prevent default double-click action
     Cancel = True
     ' call function
     'Application.Run Replace(Replace(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";", ";"), "'", """")
     'Application.Run "sample_macro(""first"";""second"")"
     Application.Run getMacro(Target.Formula), getParameter(Target.Formula)
 End If

End Sub


Private Function getMacro(value As String) As String
getMacro = Mid(value, InStr(value, "(")   2)
getMacro = Left(getMacro, InStr(getMacro, "(") - 1)
End Function

Private Function getParameter(value As String) As Variant
getParameter = Mid(value, InStr(value, "'"))
getParameter = Left(getParameter, InStr(getParameter, ")") - 1)
getParameter = Split(Replace(getParameter, "'", vbNullString), ";")
End Function

Module

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    RunMacro = display
End Function

Public Sub sample_macro(arrParameter As Variant)
    Dim i As Long
    For i = LBound(arrParameter) To UBound(arrParameter)
        MsgBox arrParameter(i)
    Next
End Sub

  • Related