1
\$\begingroup\$

I've created a report in Excel which connects to SQL Server via ODBC and I wrote some VBA to allow parameters to be passed in optionally. At this point everything works as expected but I'm curious to see if there is anything I can do to further improve it. I've brought the execution time for the full queryset (~60k records) from about 45 seconds to about 8 seconds.

Application.ScreenUpdating = False

' Variables
Dim Entity As String
Dim Project As String
Dim ProjectBillWith As String
Dim InvoiceNumber As String
Dim DraftNumber As String
Dim CustomerNumber As String
Dim CustomerName As String
Dim InvoiceDateFrom As String
Dim InvoiceDateTo As String
Dim PM As String
Dim PD As String
Dim Biller As String
Dim Status As String


Set d = CreateObject("Scripting.Dictionary")

'Initialize values with Null for SQL - parameters optional
d.Add "Entity", "Null"
d.Add "Project", "Null"
d.Add "ProjectBillWith", "Null"
d.Add "InvoiceNumber", "Null"
d.Add "DraftNumber", "Null"
d.Add "CustomerNumber", "Null"
d.Add "CustomerName", "Null"
d.Add "InvoiceDateFrom", "Null"
d.Add "InvoiceDateTo", "Null"
d.Add "PM", "Null"
d.Add "PD", "Null"
d.Add "Biller", "Null"
d.Add "Status", "Null"


' Store parameter values in dictionary if they exist
Dim Count As Integer
Count = 2

For Each Item In d.Keys()
    If IsEmpty(Range("B" & Count)) Then
    Else
        d(Item) = "'" & Range("B" & Count).Value & "'"
    End If
    Count = Count + 1
Next

'Pass the values to the variables
Entity = d("Entity")
Project = d("Project")
ProjectBillWith = d("ProjectBillWith")
InvoiceNumber = d("InvoiceNumber")
DraftNumber = d("DraftNumber")
CustomerNumber = d("CustomerNumber")
CustomerName = d("CustomerName")
InvoiceDateFrom = d("InvoiceDateFrom")
InvoiceDateTo = d("InvoiceDateTo")
PM = d("PM")
PD = d("PD")
Biller = d("Biller")
Status = d("Status")

'Pass the Parameter values to the query used in the Data Connection
With ActiveWorkbook.Connections("DB").OLEDBConnection
    .CommandText = "DECLARE @Entity CHAR(10) = " & Entity & ";" _
                    & "DECLARE @Project NVARCHAR(16) = " & Project & ";" _
                    & "DECLARE @ProjectBillWith NVARCHAR(16) = " & ProjectBillWith & ";" _
                    & "DECLARE @InvoiceNumber NVARCHAR(10) = " & InvoiceNumber & ";" _
                    & "DECLARE @DraftNumber NVARCHAR(10) = " & DraftNumber & ";" _
                    & "DECLARE @CustomerNumber NVARCHAR(15) = " & CustomerNumber & ";" _
                    & "DECLARE @CustomerName NVARCHAR(60) = " & CustomerName & ";" _
                    & "DECLARE @InvoiceDateFrom SMALLDATETIME = " & InvoiceDateFrom & ";" _
                    & "DECLARE @InvoiceDateTo SMALLDATETIME = " & InvoiceDateTo & ";" _
                    & "DECLARE @PM NVARCHAR(100) = " & PM & ";" _
                    & "DECLARE @PD NVARCHAR(100) = " & PD & ";" _
                    & "DECLARE @Biller NVARCHAR(100) = " & Biller & ";" _
                    & "DECLARE @Status VARCHAR(7) = " & Status & ";" _
                    & "SELECT [Entity], [Project], [Project Name], [Project Billwith], [PM], [PM / AA], [PD], [PD / AA], [Biller], [Biller / AA], [Group], [Invoice Type]," _
                    & "[Customer #], [Customer Name], [Invoiced Number], [Draft Number], [Invoice Date], [Cury ID], [Cury Amount], [Currency Tax Amount]," _
                    & "[Currency Balance], [Base Tax Amount], [Invoice Comments], [Status], [Payment Terms], [Last Paid Date], [Last Check #], [Last Paid Amount], [Last Doc Type] , [Total Paid Amount], [Total Unpaid Amount], [Days to Pay]" _
                    & "FROM S4DB.dbo.DBG_V_Report_AR_Data WHERE 1 = 1 AND (@Entity IS NULL OR [Entity] = @Entity)" _
                    & "AND ([Project] LIKE '%' + COALESCE(@Project, '') + '%') AND ([Project Billwith] LIKE '%' + COALESCE(@ProjectBillWith, '') + '%')" _
                    & "AND ([Invoiced Number] LIKE '%' + COALESCE(@InvoiceNumber, '') + '%') AND ([Draft Number] LIKE '%' + COALESCE(@DraftNumber, '') + '%')" _
                    & "AND ([Customer #] LIKE '%' + COALESCE(@CustomerNumber, '') + '%') AND ([Customer Name] LIKE '%' + COALESCE(@CustomerName, '') + '%')" _
                    & "AND (@InvoiceDateFrom IS NULL OR [Invoice Date] >= @InvoiceDateFrom) AND (@InvoiceDateTo IS NULL OR [Invoice Date] <= @InvoiceDateTo)" _
                    & "AND ([PM] LIKE '%' + COALESCE(@PM, '') + '%') AND ([PD] LIKE '%' + COALESCE(@PD, '') + '%')" _
                    & "AND ([Biller] LIKE '%' + COALESCE(@Biller, '') + '%') AND (@Status IS NULL OR [Status] = @Status) OPTION(RECOMPILE);"
    ActiveWorkbook.Connections("DB").Refresh
    ActiveWorkbook.RefreshAll
End With

Application.ScreenUpdating = True

Sources referenced:

\$\endgroup\$
1
  • 2
    \$\begingroup\$ I'm pretty sure you can get rid of all the COALESCE() since you are writing the whole query and can check if any of your cells are null. Also your code is vulnerable to SQL injection. \$\endgroup\$ – Snowbody Dec 22 '17 at 17:38
1
\$\begingroup\$

You haven't given your procedure a name. What's it doing? What's it called? It's missing.

If this is then Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

All of your variables do not conform to the standard.


I don't understand this if

If IsEmpty(Range("B" & Count)) Then
Else
    d(Item) = "'" & Range("B" & Count).Value & "'"
End If

Are you essentially looking for -

If Not IsEmpty(Cells(count,2) Then

You also have this line

count = count + 1

But your dictionary has an explicit size -

Dictionary.Count 'or
Ubound(Dictionary.Keys)

But, really, I'm not sure why you are taking the effort to create a dictionary object when an array will work fine-

Const ARGUMENTS As String = "Entity, Project, ProjectBillWith, InvoiceNumber, DraftNumber, CustomerNumber, CustomerName, InvoiceDateFrom, InvoiceDateTo, PM, PD, Biller, Status"
Const NUMBER_OF_ARGS As Long = 12
Dim dataArray As Variant
dataArray = Split(ARGUMENTS, ",")
Dim argumentArray(NUMBER_OF_ARGS, 1) As Variant
Dim index As Long
For index = LBound(dataArray) To UBound(dataArray)
    argumentArray(index, 0) = dataArray(index)
    argumentArray(index, 1) = Chr(39) & .Cells(index + 1, 2) & Chr(39)
Next

As for your argument string, if you need to bring your data out of the array to variables so you can build the string better, please do so. The rest of it can probably be broken up into different constants that way the constants strung together will make sense e.g.

Const DECLARE_PROJECT As String = "DECLARE @Project NVARCHAR(16) = "
Const DECLARE_ENTITIY As String = "DECLARE @Entity CHAR(10) = "
Const END_ARGUMENT As String = ";"
With ActiveWorkbook.Connections("DB").OLEDBConnection
    .CommandText = DECLARE_ENTITIY & Entity & END_ARGUMENT _
                   & DECLARE_PROJECT & Project & END_ARGUMENT
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.