Link to home
Start Free TrialLog in
Avatar of bikeski
bikeskiFlag 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

Avatar of zorvek (Kevin Jones)
zorvek (Kevin Jones)
Flag of United States of America image

SQLName is defined as a string but you are using it as a two dimensional array.

Why?

Kevin
Avatar of 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

Avatar of Kanti Prasad
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
Avatar of 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"
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
Avatar of 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

ASKER CERTIFIED SOLUTION
Avatar of zorvek (Kevin Jones)
zorvek (Kevin Jones)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of bikeski

ASKER

Hi Kevin,

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

Ron