This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.
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:
Current function:
I've tried this code but received an error "Expected Array" at line 15 strSQL = SQLName(BegDate1, EndDate1)
New function:
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)
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
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")
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
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Not sure I understand what I'm doing here. How can we make this work?
This is the sql string that get's defined.
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
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
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
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"
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
Kevin
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.
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 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
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
This is how I would implement it:
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.SubNa
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.Funct
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
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
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.SubNa
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.Funct
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
Premium Content
You need an Expert Office subscription to comment.Start Free Trial