AboutPricingCommunityTeamsStart Free TrialLog in
Avatar of bikeski
bikeski
Flag for United States of America asked on

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

Microsoft ExcelVBA
Avatar of undefined
Last Comment
bikeski
8/22/2022 - Mon
zorvek (Kevin Jones)
SQLName is defined as a string but you are using it as a two dimensional array.

Why?

Kevin
bikeski
ASKER
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

Kanti Prasad
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
This is the best money I have ever spent. I cannot not tell you how many times these folks have saved my bacon. I learn so much from the contributors.
rwheeler23
bikeski
ASKER
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"
zorvek (Kevin Jones)
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
bikeski
ASKER
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

⚡ FREE TRIAL OFFER
Try out a week of full access for free.
Find out why thousands trust the EE community with their toughest problems.
ASKER CERTIFIED SOLUTION
zorvek (Kevin Jones)
THIS SOLUTION ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
GET A PERSONALIZED SOLUTION
Ask your own question & get feedback from real experts
Find out why thousands trust the EE community with their toughest problems.
bikeski
ASKER
Hi Kevin,

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

Ron
Plans and Pricing
Resources
Product
Podcasts
Careers
Contact Us
Teams
Certified Expert Program
Credly Partnership
Udemy Partnership
Privacy Policy
Terms of Use

© 1996-2023 Experts Exchange, LLC. All rights reserved. Covered by US Patent