Extracting Data Using SQL Command Depending On Offset From Range

[timpickup]

Hi All,

I am trying to run a macro to pull data from a Workbook using an SQL command. I have 10 different cells in which I want to paste the resulting data (there are in a row, so all different columns), the values which they are pulling are based on the Offset I have put in which relates to either 4 or 3 cells above it.

Here is the code:

Private Sub LW17464()

Dim rngOutput As Range
Dim strSQL As String
Dim strFile As String
Dim Cel As Range
Dim CelLow As Integer
Dim CelHigh As Integer

    Cel = Range("_LW17464")

For Each Cel In Range("_LW17464")

    CelLow = Cel.Offset(-4, 0)
    CelHigh = Cel.Offset(-3, 0)

strFile = "E:\MES_WIPBoards\MESAllParts.xlsm"
Set rngOutput = Cel
strSQL = "SELECT [Order ID] FROM lw17464ids WHERE [Current OP]>(CelLow) AND [Current OP]<=(CelHigh)"
'strSQL = "SELECT DISTINCT [Part No] FROM output_Table_2;"

Call PasteFromSQL(strSQL, strFile, rngOutput)
Next
End Sub

I have tried everything and keep getting the error 'Object variable or With variable not set'

Does anyone have any suggestions.

 

[Andrew Poulsom]

Does this work for you?

Private Sub LW17464()
    Dim rngOutput As Range
    Dim strSQL As String
    Dim strFile As String
    Dim Cel As Range
    Dim CelLow As Integer
    Dim CelHigh As Integer
    For Each Cel In Range("_LW17464")
        CelLow = Cel.Offset(-4, 0).Value
        CelHigh = Cel.Offset(-3, 0).Value
        strFile = "E:\MES_WIPBoards\MESAllParts.xlsm"
        Set rngOutput = Cel
        strSQL = "SELECT [Order ID] FROM lw17464ids WHERE [Current OP]>(" & CelLow & ") AND [Current OP]<=(" & CelHigh & ")"
'       strSQL = "SELECT DISTINCT [Part No] FROM output_Table_2;"
        Call PasteFromSQL(strSQL, strFile, rngOutput)
    Next Cel
End Sub

 

[timpickup]

Thanks for your reply,

I'm getting an error still, this time it reads 'Automation Error' 'Unspecified Error'

 

[Andrew Poulsom]

Which line causes the error?

 

[timpickup]

After adding breakpoints to the code you provided, I found that the error was being caused by my SQL call. The code for this is:

Sub PasteFromSQL(strSQL As String, strFile As String, rngOutput As Range) 'outputs an SQL query from a specified file into a defined range.

    Dim conn As ADODB.Connection
    Dim rs As ADODB.Recordset
    
    sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                  "Data Source=" & strFile & ";" & _
                  "Extended Properties=Excel 8.0;"
    ' For Access
    'sConnString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    '"Data Source=" & strFile & ";" & "Jet OLEDB:Database;"

    Set conn = New ADODB.Connection
    Set rs = New ADODB.Recordset

    ' Open the connection and execute.
    conn.Open sConnString
    Set rs = conn.Execute(strSQL)

    ' Check we have data.
    If Not rs.EOF Then
        ' Transfer result.
        rngOutput.CopyFromRecordset rs
    ' Close the recordset
        rs.Close
    Else
    '    MsgBox "Error: No records returned.", vbCritical ' Optional statement, default is off. Uncomment to apply
    End If

    ' Clean up
    If CBool(conn.State And adStateOpen) Then conn.Close
    Set conn = Nothing
    Set rs = Nothing
   
End Sub

The error was appearing on line ' conn.Open sConnString'.

Any suggestions?

Thanks, Tim

 

[Andrew Poulsom]

Has that procedure ever worked? What is the value of sConnString when you get the error?

 

[timpickup]

Yeah, it works with this code:

Private Sub CommandButton1_Click()
Dim rngOutput As Range
Dim strSQL As String
Dim strFile As String

tplevelone = "LW17464"
strFile = "E:\MES_WIPBoards\MWS_Automation(JC).xlsm"
Set rngOutput = Range("current_list")
strSQL = "SELECT [Part No], [Order ID], [Seq] FROM output_table_2 WHERE [Part No] ='" & tplevelone & "';"
'strSQL = "SELECT DISTINCT [Part No] FROM output_Table_2;"

Call PasteFromSQL(strSQL, strFile, rngOutput)

End Sub

 

[Andrew Poulsom]

It's not failing in that procedure, but strFile is different.

Working: strFile = "E:\MES_WIPBoards\MWS_Automation(JC).xlsm"
Not working: strFile = "E:\MES_WIPBoards\MESAllParts.xlsm"