Passing Cell value to VBA SQL Query

[brian6464]

I know this is probably easy but I have not been able to get it figured out. I have two sheets....Input and Output. I have a sql query (using MS Query) that returns the correct data onto 'Output' when I have filters hardcoded into my Where clause. What I want to do is have an input cell(s) on 'Input' sheet and pass the value(s) to the query to populate the 'Output' sheet. In the code below, there are two lines in red. If I run using the first line with hardcoded sample id's, it works fine and puts the data to Output. If I run trying to reference the cell D3 on the input sheet to pass sample id 2154150, it fails. What am I doing wrong? Thanks.

Also, if the user wants to pass multiple sample id's, how would I accomplish this. I would imagine I could have them input each sample id in a different cell and then range it or have them input the samples in one cell separated by commas.

Dim cn As ADODB.Connection
  Dim rs As ADODB.Recordset
  Dim i As Integer
  Dim strSQL As String
  Dim UserName As String
  
  Set cn = New ADODB.Connection
  Set rs = New ADODB.Recordset
  cn.Open ( _
     "Provider=SQLOLEDB; " & _
            "MyDataSource; " & _
            "MyDataBase; " & _
            "Trusted_Connection=yes")
                         
  If (cn.State <> 1) Then
    intResult = MsgBox("Could not connect to the database.  Check your user name and password." & vbCrLf & Error(Err), 16, "Refresh Data")
  Else
      strSQL = "SELECT " & vbCrLf
      strSQL = strSQL & "Distinct Sample_Id, " & vbCrLf
      strSQL = strSQL & "Unit_Number, " & vbCrLf
      strSQL = strSQL & "Unit_Description, " & vbCrLf
      strSQL = strSQL & "Sample_Time, " & vbCrLf
      strSQL = strSQL & "Sample_Point_Number, " & vbCrLf
      strSQL = strSQL & "Sample_Point, " & vbCrLf
      strSQL = strSQL & "Profile_Number " & vbCrLf
      strSQL = strSQL & " " & vbCrLf
      strSQL = strSQL & "From dbo.LAB_TestResults " & vbCrLf
      [COLOR=#ff0000]strSQL = strSQL & "Where Sample_Id in ('2154150','2154149') " & vbCrLf
      'strSQL = strSQL & "Where Sample_Id  = ActiveWorkbook.Sheets("Input").Range("$D3") " & vbCrLf[/COLOR]
      strSQL = strSQL & "ORDER BY Unit_Number, Unit_Description, Sample_Time, Sample_Point_Number, Sample_Point, Profile_Number "
      rs.Open strSQL, cn
  
      If rs.State = 1 Then
  
            ActiveWorkbook.Sheets("Output").Activate
            ActiveSheet.Cells.ClearContents
            
            For i = 0 To rs.Fields.Count - 1
                ActiveSheet.Cells(1, i + 1).Value = rs.Fields(i).Name
            Next i
            ActiveSheet.Range(ActiveSheet.Cells(1, 1), ActiveSheet.Cells(1, rs.Fields.Count)).Font.Bold = True
    
            ActiveSheet.Range("A2").CopyFromRecordset rs
            
            'Auto-fit up to 26 columns
            ActiveSheet.Columns("A:" & Chr(64 + rs.Fields.Count)).AutoFit
  
            rs.Close
            
        End If
  End If
End Sub

 

[ScottR]

Untested but try

"Where Sample_Id =" & ActiveWorkbook.Sheets("Input").Range("$D3") & vbCrLf

 

[JackDanIce]

There's a lot of string manipulation going on there, one "trick" is to use Replace to make the query easier to read and edit, e.g.

Sub Test()
Dim str as String

Str = "SELECT @1Distinct Sample_Id, @1Unit_Number @1@2"
Str = Replace(str, "@1", vbCrLf)
Str = Replace(str, "@2", Range("A1").Value)

Msgbox Str
End Sub

Hopefully you get the idea and can adapt. I'd probably recommend making the whole SQL string part a separate function e.g.

Sub Macro1()

Dim str as String
str = MySQL(Range("A1"))
Msgbox str
' rest of your code
End Sub

Private Function MySQL(byref rng as Range) as String

MySql = "Select blah @2 blah @1"
MySql = Replace(mySql, "@2", rng.value)
MySql = Replace(MySql, "@1", vbCrLF)

End Function

To separate it out from your loop as well as making changes easier (IMO)

 

[brian6464]

Untested but try

"Where Sample_Id =" & ActiveWorkbook.Sheets("Input").Range("$D3") & vbCrLf

This worked thanks. Currently, I have just one value in cell B3 of the Input sheet. What would be the best option for passing multiple id's keyed in by the user?

I tried the following: "Where Sample_Id =" & ActiveWorkbook.Sheets("Input").Range("$D3:$E3") & vbCrLf with an id value in both D3 and E3. Did not work.

 

[brian6464]

There's a lot of string manipulation going on there, one "trick" is to use Replace to make the query easier to read and edit, e.g.

Sub Test()
Dim str as String

Str = "SELECT @1Distinct Sample_Id, @1Unit_Number @1@2"
Str = Replace(str, "@1", vbCrLf)
Str = Replace(str, "@2", Range("A1").Value)

Msgbox Str
End Sub

Hopefully you get the idea and can adapt. I'd probably recommend making the whole SQL string part a separate function e.g.

Sub Macro1()

Dim str as String
str = MySQL(Range("A1"))
Msgbox str
' rest of your code
End Sub

Private Function MySQL(byref rng as Range) as String

MySql = "Select blah @2 blah @1"
MySql = Replace(mySql, "@2", rng.value)
MySql = Replace(MySql, "@1", vbCrLF)

End Function

To separate it out from your loop as well as making changes easier (IMO)

Thanks for the input, I appreciate it. It is actually someone else's code and I am just trying to get it to work the way I want. Once I have it functioning, then I'll review your suggestions for optimizing.

 

[ScottR]

Using a similar approach to JackDanIce's advice I'd create a UDF to output the desired string

Function InClause(Rng As Range) As String

For Each cell In Rng
    If cell.Value <> "" Then
        If InClause <> "" Then InClause = InClause & ","
        InClause = InClause & cell.Value
    End If
Next

End Function

Making the SQL Line...

strSQL = strSQL & "Where Sample_Id in (" & InClause(ActiveWorkbook.Sheets("Input").Range("$D3:$E3")) & ") " & vbCrLf

 

[brian6464]

Using a similar approach to JackDanIce's advice I'd create a UDF to output the desired string

Function InClause(Rng As Range) As String

For Each cell In Rng
    If cell.Value <> "" Then
        If InClause <> "" Then InClause = InClause & ","
        InClause = InClause & cell.Value
    End If
Next

End Function

Making the SQL Line...

strSQL = strSQL & "Where Sample_Id in (" & InClause(ActiveWorkbook.Sheets("Input").Range("$D3:$E3")) & ") " & vbCrLf

Worked perfectly for what I needed. Appreciate the help!

 

[JackDanIce]

You're welcome and hope you learnt a new bit of coding!