Passing a Function Name in VBA

Hello Experts,

I'd like to pass a function name in VBA. Here is the code used currently

Call function via:
 Range(Cell).Value = StoreSalesSF(BegDate, EndDate)

Open in new window


Current function:
Function StoreSalesSF(BegDate1, EndDate1) As Variant

Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\zzz\gdbcreation\sv1020_012HO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLStoreSalesSF(BegDate1, EndDate1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
    StoreSalesSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
    If IsNull(StoreSalesSF) Then
       StoreSalesSF = 0
    End If
  Else
    StoreSalesSF = 0
  End If
  conSQL.Close
End Function

Open in new window


I've tried this code but received an error "Expected Array" at line 15  strSQL = SQLName(BegDate1, EndDate1)

 Range(Cell).Value = SumFunctionSF(BegDate, EndDate, "StoreSalesSF") 

Open in new window


New function:


Function SumFunctionSF(BegDate1 As Variant, EndDate1 As Variant, Title1 As String)

Dim conSQL As ADODB.Connection
Dim strSQL, SQLName As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\zzz\gdbcreation\sv1020_012HO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  SQLCall = "SQL" & Title1
  strSQL = SQLName(BegDate1, EndDate1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
    SumFunctionSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
    If IsNull(SumFunctionSF) Then
       SumFunctionSF = 0
    End If
  Else
    SumFunctionSF = 0
  End If
  conSQL.Close
End Function 

Open in new window

bikeskiAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

zorvek (Kevin Jones)ConsultantCommented:
SQLName is defined as a string but you are using it as a two dimensional array.

Why?

Kevin
0
bikeskiAuthor Commented:
Not sure I understand what I'm doing here. How can we make this work?

This is the sql string that get's defined.

Function SQLStoreSalesSF(BegDate1, EndDate1) As String
SQLStoreSalesSF = "Select Sum(orderdetail.qshipped * orderdetail.p_sellprice)AS sum_Sales" & _
    " From orderdetail" & _
    " WHERE orderdetail.invoice<>'N/A'" & _
    " AND orderdetail.pclass NOT IN ('6065')" & _
    " AND orderdetail.shipdate BETWEEN (" & BegDate1 & ") AND (" & EndDate1 & ")"

End Function

Open in new window

0
Kanti PrasadCommented:
Hi

comment
'strSQL = SQLName(BegDate1, EndDate1)

and  try it with direct sql.


rs.Open "SELECT qshipped FROM orderdetail", conSQL, adOpenStatic, adLockOptimistic

Here are some links

http://analysistabs.com/excel-vba/ado-sql-macros-connecting-database/
https://support.microsoft.com/en-us/kb/257819
0
Cloud Class® Course: Ruby Fundamentals

This course will introduce you to Ruby, as well as teach you about classes, methods, variables, data structures, loops, enumerable methods, and finishing touches.

bikeskiAuthor Commented:
Hi Kanti,

I use the strSQL function call because I have about 30 different sql calls to make for various data imports.

My goal is to eliminate the redundancy of creating a separate function like:
"Function StoreSalesSF(BegDate1, EndDate1)"
into a generic reusable function like:
"Function SumFunctionSF(BegDate1 As Variant, EndDate1 As Variant, Title1 As String)".

This way I only need to define and change the strSQL call like:
"Function SQLStoreSalesSF(BegDate1, EndDate1"
0
zorvek (Kevin Jones)ConsultantCommented:
Post a few examples of complete SQL commands you want to send to SQL Server and we can build a generic routine to create the strings using parameters pass to a single generic function. The more examples the better.

Kevin
0
bikeskiAuthor Commented:
These are samples of the functions I'd like to make generic. As you can see there's a great deal of duplication of code.
Function WeeklyInvAtCostAllSF(FiscalWeek1, FiscalYear1) As Variant

Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\multidev\gdbcreation\sv1020_STATHO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLWeeklyInvAtCostAllSF(FiscalWeek1, FiscalYear1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
     WeeklyInvAtCostAllSF = rs.GetRows(-1, 1, "sum_cost")(0, 0)
    If IsNull(WeeklyInvAtCostAllSF) Then
       WeeklyInvAtCostAllSF = 0
    End If
  Else
    WeeklyInvAtCostAllSF = 0
  End If
  conSQL.Close
End Function

Function WeeklyInvAtCurrentRetailAllSF(FiscalWeek1, FiscalYear1) As Variant
Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\multidev\gdbcreation\sv1020_STATHO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLWeeklyInvAtCurrentRetailAllSF(FiscalWeek1, FiscalYear1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
     WeeklyInvAtCurrentRetailAllSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
    If IsNull(WeeklyInvAtCurrentRetailAllSF) Then
       WeeklyInvAtCurrentRetailAllSF = 0
    End If
  Else
    WeeklyInvAtCurrentRetailAllSF = 0
  End If
  conSQL.Close
End Function

Function WeeklyInvUnitsAllSF(FiscalWeek1, FiscalYear1) As Variant

Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\multidev\gdbcreation\sv1020_STATHO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLWeeklyInvUnitsAllSF(FiscalWeek1, FiscalYear1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
     WeeklyInvUnitsAllSF = rs.GetRows(-1, 1, "sum_units")(0, 0)
    If IsNull(WeeklyInvUnitsAllSF) Then
       WeeklyInvUnitsAllSF = 0
    End If
  Else
    WeeklyInvUnitsAllSF = 0
  End If
  conSQL.Close
End Function


Function WeeklySalesAllSF(FiscalWeek1, FiscalYear1) As Variant

Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\multidev\gdbcreation\sv1020_STATHO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLWeeklySalesAllSF(FiscalWeek1, FiscalYear1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
     WeeklySalesAllSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
    If IsNull(WeeklySalesAllSF) Then
       WeeklySalesAllSF = 0
    End If
  Else
    WeeklySalesAllSF = 0
  End If
  conSQL.Close
End Function

Function WeeklyUnitSalesAllSF(FiscalWeek1, FiscalYear1) As Variant

Dim conSQL As ADODB.Connection
Dim strSQL As String
Dim i As Integer
Dim Total As Variant
Dim rs As ADODB.Recordset

Total = 0
i = 0

  Set conSQL = New ADODB.Connection
  conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\multidev\gdbcreation\sv1020_STATHO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
  strSQL = SQLWeeklyUnitSalesAllSF(FiscalWeek1, FiscalYear1)
  Set rs = New ADODB.Recordset
  rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
     
  If Not rs.EOF Then
     WeeklyUnitSalesAllSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
    If IsNull(WeeklyUnitSalesAllSF) Then
       WeeklyUnitSalesAllSF = 0
    End If
  Else
    WeeklyUnitSalesAllSF = 0
  End If
  conSQL.Close
End Function

Open in new window


These are some examples of the SQL commands that I'm using.  I like doing it this way as it's easy to error check and maintain the SQL commands.
Function SQLStoreSalesSF(BegDate1, EndDate1) As String
SQLStoreSalesSF = "Select Sum(orderdetail.qshipped * orderdetail.p_sellprice)AS sum_Sales" & _
    " From orderdetail" & _
    " WHERE orderdetail.invoice<>'N/A'" & _
    " AND orderdetail.pclass NOT IN ('6065')" & _
    " AND orderdetail.shipdate BETWEEN (" & BegDate1 & ") AND (" & EndDate1 & ")"

End Function

Function SQLStoreCogsSF(BegDate1, EndDate1) As String
SQLStoreCogsSF = "Select Sum(orderdetail.qshipped * orderdetail.accost)AS sum_Sales" & _
    " From orderdetail" & _
    " WHERE orderdetail.invoice<>'N/A'" & _
    " AND orderdetail.pclass NOT IN ('6065')" & _
    " AND orderdetail.shipdate BETWEEN (" & BegDate1 & ") AND (" & EndDate1 & ")"

End Function

Function SQLStoreCountTransactionsSF(BegDate1, EndDate1) As String
SQLStoreCountTransactionsSF = "Select COUNT( DISTINCT orderdetail.invoice)AS sum_Sales" & _
    " From orderdetail" & _
    " WHERE orderdetail.invoice<>'N/A'" & _
    " AND orderdetail.pclass NOT IN ('6065')" & _
    " AND orderdetail.shipdate BETWEEN (" & BegDate1 & ") AND (" & EndDate1 & ")"

End Function

Function SQLWeeklyInvAtCostPartsSF(FiscalWeek1, FiscalYear1) As String
SQLWeeklyInvAtCostPartsSF = "Select Sum(WEEKSUMMCL.STOCKCOST) AS sum_cost" & _
    " From WEEKSUMMCL" & _
    " WHERE WEEKSUMMCL.FISCALYEAR IN (" & Chr(39) & Format(FiscalYear1, "####") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.FISCALWEEK IN (" & Chr(39) & Format(FiscalWeek1, "##") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.PCLASS IN ('3030', '3033') "
End Function

Function SQLWeeklyInvAtCurrentRetailPartsSF(FiscalWeek1, FiscalYear1) As String
SQLWeeklyInvAtCurrentRetailPartsSF = "Select Sum(WEEKSUMMCL.STOCKPKPRICE) AS sum_sales" & _
    " From WEEKSUMMCL" & _
    " WHERE WEEKSUMMCL.FISCALYEAR IN (" & Chr(39) & Format(FiscalYear1, "####") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.FISCALWEEK IN (" & Chr(39) & Format(FiscalWeek1, "##") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.PCLASS IN ('3030', '3033') "

End Function

Function SQLWeeklyInvUnitsPartsSF(FiscalWeek1, FiscalYear1) As String
SQLWeeklyInvUnitsPartsSF = "Select Sum(WEEKSUMMCL.STOCKLEVEL) AS sum_units" & _
    " From WEEKSUMMCL" & _
    " WHERE WEEKSUMMCL.FISCALYEAR IN (" & Chr(39) & Format(FiscalYear1, "####") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.FISCALWEEK IN (" & Chr(39) & Format(FiscalWeek1, "##") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.PCLASS IN ('3030', '3033') "

End Function

Function SQLWeeklySalesPartsSF(FiscalWeek1, FiscalYear1) As String
SQLWeeklySalesPartsSF = "Select Sum(WEEKSUMMCL.SalesDOLS) AS sum_Sales" & _
    " From WEEKSUMMCL" & _
    " WHERE WEEKSUMMCL.FISCALYEAR IN (" & Chr(39) & Format(FiscalYear1, "####") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.FISCALWEEK IN (" & Chr(39) & Format(FiscalWeek1, "##") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.PCLASS IN ('3030', '3033') "

End Function

Function SQLWeeklyUnitSalesPartsSF(FiscalWeek1, FiscalYear1) As String
SQLWeeklyUnitSalesPartsSF = "Select Sum(WEEKSUMMCL.STSalesQTY) AS sum_Sales" & _
    " From WEEKSUMMCL" & _
    " WHERE WEEKSUMMCL.FISCALYEAR IN (" & Chr(39) & Format(FiscalYear1, "####") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.FISCALWEEK IN (" & Chr(39) & Format(FiscalWeek1, "##") & Chr(39) & ")" & _
    " AND   WEEKSUMMCL.PCLASS IN ('3030', '3033') "

End Function

Open in new window

0
zorvek (Kevin Jones)ConsultantCommented:
This is how I would implement it:

Public Enum tFunctionType
    FunctionType_StoreSalesSF
    FunctionType_StoreCogsSF
    FunctionType_StoreCountTransactionsSF
    FunctionType_WeeklyInvAtCostPartsSF
    FunctionType_WeeklyInvAtCurrentRetailPartsSF
    FunctionType_WeeklyInvUnitsPartsSF
    FunctionType_WeeklySalesPartsSF
    FunctionType_WeeklyUnitSalesPartsSF
End Enum

Public Function StoreSalesSF( _
        ByVal FirstParameter As Variant, _
        ByVal SecondParameter As Variant, _
        ByVal FunctionType As tFunctionType _
    ) As Variant

    Dim conSQL As ADODB.Connection
    Dim strSQL As String
    Dim rs As ADODB.Recordset
    
    Set conSQL = New ADODB.Connection
    conSQL.Open "DSN=CDHO;Driver={Firebird/InterBase(r) driver};Dbname=192.168.0.205:d:\zzz\gdbcreation\sv1020_012HO.gbb;CHARSET=NONE;UID=BETAVIEW;Client=C:\Windows\SysWOW64\gds32.dll"
    
    Select Case FunctionType
        Case FunctionType_StoreSalesSF
            strSQL = SQLStoreSalesSF(FirstParameter, SecondParameter)
        Case FunctionType_StoreCogsSF
            strSQL = SQLStoreCogsSF(FirstParameter, SecondParameter)
        Case FunctionType_StoreCountTransactionsSF
            strSQL = SQLStoreCountTransactionsSF(FirstParameter, SecondParameter)
        Case FunctionType_WeeklyInvAtCostPartsSF
            strSQL = SQLWeeklyInvAtCostPartsSF(FirstParameter, SecondParameter)
        Case FunctionType_WeeklyInvAtCurrentRetailPartsSF
            strSQL = SQLWeeklyInvAtCurrentRetailPartsSF(FirstParameter, SecondParameter)
        Case FunctionType_WeeklyInvUnitsPartsSF
            strSQL = SQLWeeklyInvUnitsPartsSF(FirstParameter, SecondParameter)
        Case FunctionType_WeeklySalesPartsSF
            strSQL = SQLWeeklySalesPartsSF(FirstParameter, SecondParameter)
        Case FunctionType_WeeklyUnitSalesPartsSF
            strSQL = SQLWeeklyUnitSalesPartsSF(FirstParameter, SecondParameter)
    End Select
    
    Set rs = New ADODB.Recordset
    rs.Open strSQL, conSQL, adOpenStatic, adLockOptimistic
    
    If Not rs.EOF Then
        StoreSalesSF = rs.GetRows(-1, 1, "sum_sales")(0, 0)
        If IsNull(StoreSalesSF) Then
            StoreSalesSF = 0
        End If
    Else
        StoreSalesSF = 0
    End If
    conSQL.Close

End Function

Open in new window


It is possible to call functions the way you want but it's more prone to runtime errors (incorrect function name passed). Here are the instructions.

By turning off error handling, calls can be made to subs and functions in general code modules, sheet code modules, and the ThisWorkbook code module that may not exist. The sample code below illustrates how to do this with each possible location and how to call a sub and a function.

Calling a sub:

    On Error Resume Next
    Run "SubName", Param1, Param2
    Run "'Workbook Name.xlsm'!SubName", Param1, Param2
    Run "'Workbook Name.xlsm'!SheetName.SubName", Param1, Param2
    On Error GoTo 0

Call a function:

    On Error Resume Next
    Result = Run("FunctionName", Param1, Param2)
    Result = Run("'Workbook Name.xlsm'!FunctionName", Param1, Param2)
    Result = Run("'Workbook Name.xlsm'!SheetName.FunctionName", Param1, Param2)
    On Error GoTo 0

Note that when calling a function the Result variable should be pre-initialized to a value that will not be returned by the function to determine whether or not the function exists. An alternative is to check for a 1004 error when calling a routine in a general code module or the ThisWorkbook code module, or a 438 error when calling a routine in a sheet code module.

Note that any parameters passed using the Run command are converted to values. Parameters cannot be passed by reference.

Kevin
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bikeskiAuthor Commented:
Hi Kevin,

Thank you for the detailed solution, it's always great to learn and to understand what's going on.

Ron
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.