SQL + VBA Populating Data in Cell Range

Question

I currently have a code that is connecting to SQL database in VBA. The data is populating correctly. However, I was wondering if there is a way to condense the code below.

I have 4 different columns and 26 rows and I feel like if I go this route, I will be wasting a lot of time. I want the range to go from C20:C45 and the results to show from cells H20:H45.

Sub ConnectSqlServer()

    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Dim sConnString As String
    Dim wks As Worksheet, xRow As Long


    ' Create the connection string.
    sConnString = "Provider=SQLOLEDB;Data Source=chocnt-285;" & _
                  "Initial Catalog=trackerfy2015;" & _
                  "Integrated Security=SSPI;"

    ' Create the Connection and Recordset objects.
    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset
' Open the connection and execute data for WFTEs.
   Set rs = conn.Execute("SELECT sum(Hours)/80 FROM payroll2015_rif WHERE DepartmentCode = '" & Range("$E$6") & "' AND payperiod = '" & Range("C20") & "' and paycode IN ('REG1', 'REG2');")
        ' Transfer result.
        Sheets(2).Range("$H20").CopyFromRecordset rs
    ' Close the recordset
        rs.Close


' Open the connection and execute data for WFTEs.
   Set rs = conn.Execute("SELECT sum(Hours)/80 FROM payroll2015_rif WHERE DepartmentCode = '" & Range("$E$6") & "' AND payperiod = '" & Range("C21") & "' and paycode IN ('REG1', 'REG2');")
        ' Transfer result.
         Sheets(2).Range("$H21").CopyFromRecordset rs
 ' Clean up
    If CBool(conn.State And adStateOpen) Then conn.Close
    Set conn = Nothing
    Set rs = Nothing

End Sub

Answer 1

What you need is an ADODB.Command. It's the same query with different parameters, so you should use a parameterized query. Honestly, you should be using a parameterized query anyway. You have no idea what the user has put into those cells. This is a SQL Injection disaster waiting to happen. Let's say I put '; DROP DATABASE trackerfy2015 -- into cell E6. Boom. There goes your entire database. Poof. Gone. Up in smoke.

xkcd: Exploits of a Mom

So, about that parameterized query..

Dim cmd as New ADODB.Command

Const sql As String = & _
    "SELECT sum(Hours)/80 " & _
    "FROM payroll2015_rif " & _
    "WHERE DepartmentCode = ? " & _
        "AND payperiod = ? " & _
        "AND paycode IN ('REG1', 'REG2');"

With cmd
    .CommandType = adCmdText
    .CommandText = sql
    .ActiveConnection = conn

    .Parameters.Append .CreateParameter(Name, Type, adParamInput, Size, Range("$E$6").Value)
    .Parameters.Append .CreateParameter(Name, Type, adParamInput, Size, Range("C20").Value)

    Set rs = .Execute
End With

' Transfer Result
Sheets(2).Range("$H20").CopyFromRecordset rs

' reset the value of the second parameter
cmd.Parameters(1).Value = Range("C21")

Set rs = cmd.Execute

Note that I didn't set all of the parameters for the CreateParameter function because I have no way of knowing the appropriate values.

I need to mention something that you did very very right. Using Worksheet.CopyFromRecordSet is by and far the most efficient way to transfer data from a Recordset to a worksheet. Well done. You have no idea how often I see people loop through a recordset to populate a worksheet. I'm very happy to see you do it the right way.

---

Some other notes:

1. You have unused variables wks and xrow. Put the first to good use by setting it to Sheets(2). This way if the destination sheet should ever need to change, you only have to do it in one place. Remove the other dead variable.
2. Add an error handler so you can make sure the connection and recordset always get closed no matter what happens.