Running multiple queries in a macro into one sheet

LZ_Code

New Member
Joined
Jan 30, 2025
Messages
25
Office Version
  1. 365
Platform
  1. Windows
Thanking everyone in advance fore your help!
Wondering if this is possible, I am trying to run two queries. I am stuck after the 1st query, it works but then nothing. Need to scan locate the next available row and pasting the next query. I keep getting syntax errors not sure what I am missing.

VBA Code:
Sub A_FindLastCell()
    
    'Path
    Dim strPath As String
    
    'Provider
    Dim strProv As String
    
    'Connection String
    Dim strCn As String
    
    'Connection
    Dim Cn As New Connection
                  
    'RecordSet for RackIOCfg
    Dim rsQry_IOCfg As New Recordset
    
    'SQL Query for RackIOCfg
    Dim strQry_IOCfg As String
    
    'RecordSet for RackPNCfg
    Dim rsQry_PNCfg As New Recordset
    
    'SQL Query for RackPNCfg
    Dim strQry_PNCfg As String
       
    'Panel Criteria
    Dim rngCriteria As Range
    Dim strCriteria As String
    
    With Worksheets("PAGE")
        Set rngCriteria = .Range("B" & 6)
        ' Resize for a list of criteria
        Set rngCriteria = .Range(rngCriteria, .Cells(rngCriteria.Column))
        ' Build Criteria String
        strCriteria = "('" & Join(Application.Transpose(rngCriteria.Value), "','") & "')"
    End With
    
    
    'Establish connection to Project DB. Looks at the filepath specified in cell B1 of Project_DB Sheet
    strPath = ActiveWorkbook.Sheets("PAGE").Range("B2").Text
    strProv = "Microsoft.ACE.OLEDB.12.0;"
    strCn = "Provider=" & strProv & "Data Source=" & _
    strPath

    'Connection Open
    Cn.Open strCn
                
    strQry_IOCfg = "SELECT RackIOCfg.ModulePartNo, RackIOCfg.ModuleDesc FROM RackIOCfg" _
                & " WHERE RackIOCfg.Panel IN " & strCriteria _
                & " ORDER BY RackIOCfg.Panel;"
    
    rsQry_IOCfg.Open strQry_IOCfg, Cn
    
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_IOCfg
    
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_IOCfg
    
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
    
    rsQry_PNCfg.Open strQry_PNCfg, Cn
    
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_PNCfg
    
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_PNCfg
    
    Cn.Close
    
End Sub
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
It seems to me that you have several problems in your code, I couldn't test the connection.
If it works for you, change these lines:
VBA Code:
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_IOCfg
    
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_IOCfg
    
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
    
    rsQry_PNCfg.Open strQry_PNCfg, Cn
    
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_PNCfg
    
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_PNCfg
    
    Cn.Close

For this:
VBA Code:
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With
    
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
    
    rsQry_PNCfg.Open strQry_PNCfg, Cn
    
    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With
    
    Cn.Close

------------------------------
But the following macro does work for me and can obtain the data from the 2 queries:
VBA Code:
Sub A_FindLastCell_v2()
  Dim con As Object, rs As Object
  Dim db As String, sql1 As String, sql2 As String, strCriteria As String, strCon As String
  Dim rngCriteria As Range
  
  Set con = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
  db = Sheets("PAGE").Range("B2").Value
  
  Set rngCriteria = Sheets("PAGE").Range("B6:B8")  'fit the cell range
  strCriteria = "('" & Join(Application.Transpose(rngCriteria.Value), "','") & "')"
  
  sql1 = "SELECT [ModulePartNo], [ModuleDesc] " & _
         "FROM [RackIOCfg$] " & _
         "WHERE [Panel] IN " & strCriteria & " " & _
         "ORDER BY [Panel]"
  
  sql2 = "SELECT [RackPartNo], [RackDesc] " & _
         "FROM [RackCfg$] " & _
         "WHERE [Panel] IN " & strCriteria & " " & _
         "ORDER BY [Panel]"
  strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db & "; Extended Properties=""Excel 12.0; HDR=YES"";"
  
  With Sheets("Sheet2")
    con.Open strCon
      rs.Open sql1, con
      .Range("A1").CopyFromRecordset rs.DataSource
    con.Close
    
    con.Open strCon
      rs.Open sql2, con
      .Range("A" & Rows.Count).End(3)(2).CopyFromRecordset rs.DataSource
    con.Close
  End With
End Sub


😇
 
Upvote 0
Solution
It seems to me that you have several problems in your code, I couldn't test the connection.
If it works for you, change these lines:
VBA Code:
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_IOCfg
   
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_IOCfg
   
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
   
    rsQry_PNCfg.Open strQry_PNCfg, Cn
   
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    ActiveWorkbook.Sheets("Sheet2").Range ("A13")
    lastRow = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LastColumn = .Cells.Find(What:="*", After:=[A13], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    ActiveWorkbook.Sheets("Sheet2") = CopyFromRecordset.Range(.Cells(1, 1), .Cells(lastRow, LastColumn)) rsQry_PNCfg
   
    'Puts Data into the Device Column of the Digital Device Sheet
    'ActiveWorkbook.Sheets("Sheet2").Range("A13").CopyFromRecordset rsQry_PNCfg
   
    Cn.Close

For this:
VBA Code:
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With
   
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
   
    rsQry_PNCfg.Open strQry_PNCfg, Cn
   
    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With
   
    Cn.Close

------------------------------
But the following macro does work for me and can obtain the data from the 2 queries:
VBA Code:
Sub A_FindLastCell_v2()
  Dim con As Object, rs As Object
  Dim db As String, sql1 As String, sql2 As String, strCriteria As String, strCon As String
  Dim rngCriteria As Range
 
  Set con = CreateObject("ADODB.Connection")
  Set rs = CreateObject("ADODB.Recordset")
  db = Sheets("PAGE").Range("B2").Value
 
  Set rngCriteria = Sheets("PAGE").Range("B6:B8")  'fit the cell range
  strCriteria = "('" & Join(Application.Transpose(rngCriteria.Value), "','") & "')"
 
  sql1 = "SELECT [ModulePartNo], [ModuleDesc] " & _
         "FROM [RackIOCfg$] " & _
         "WHERE [Panel] IN " & strCriteria & " " & _
         "ORDER BY [Panel]"
 
  sql2 = "SELECT [RackPartNo], [RackDesc] " & _
         "FROM [RackCfg$] " & _
         "WHERE [Panel] IN " & strCriteria & " " & _
         "ORDER BY [Panel]"
  strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db & "; Extended Properties=""Excel 12.0; HDR=YES"";"
 
  With Sheets("Sheet2")
    con.Open strCon
      rs.Open sql1, con
      .Range("A1").CopyFromRecordset rs.DataSource
    con.Close
   
    con.Open strCon
      rs.Open sql2, con
      .Range("A" & Rows.Count).End(3)(2).CopyFromRecordset rs.DataSource
    con.Close
  End With
End Sub


😇
Thank you!
Weird, I keep having this error. Not sure why.


1739205914272.png
 
Upvote 0
In my code, Change this line:

VBA Code:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db & "; Extended Properties=""Excel 12.0; HDR=YES"";"

for this line:

VBA Code:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db


Try and comment


Additionally, exactly what data do you have in cell B2 of the "PAGE" sheet. Did you verify that that file name exists?
 
Upvote 0
In my code, Change this line:

VBA Code:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db & "; Extended Properties=""Excel 12.0; HDR=YES"";"

for this line:

VBA Code:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & db


Try and comment


Additionally, exactly what data do you have in cell B2 of the "PAGE" sheet. Did you verify that that file name exists?

yes - tried the 1st code with the changes u mentioned for mine but then no data imported from DB.
Then I tried your code and adjustments pointed out and now I have this error.

The File exists - it is copied directly from the file.
1739209174685.png

1739209127729.png
 
Upvote 0
The IOCgf is working now. I had to delete all data and even borders in the sheet in order for it to work. But the PNCfg is not working.

VBA Code:
Sub A_FindLastCell()
    
    'Path
    Dim strPath As String
    
    'Provider
    Dim strProv As String
    
    'Connection String
    Dim strCn As String
    
    'Connection
    Dim Cn As New Connection
                  
    'RecordSet for RackIOCfg
    Dim rsQry_IOCfg As New Recordset
    
    'SQL Query for RackIOCfg
    Dim strQry_IOCfg As String
    
    'RecordSet for RackPNCfg
    Dim rsQry_PNCfg As New Recordset
    
    'SQL Query for RackPNCfg
    Dim strQry_PNCfg As String
       
    'Panel Criteria
    Dim rngCriteria As Range
    Dim strCriteria As String
    
    With Worksheets("PAGE")
        Set rngCriteria = .Range("B" & 5)
        ' Resize for a list of criteria
        Set rngCriteria = .Range(rngCriteria, .Cells(rngCriteria.Column))
        ' Build Criteria String
        strCriteria = "('" & Join(Application.Transpose(rngCriteria.Value), "','") & "')"
    End With
    
    
    'Establish connection to Project DB. Looks at the filepath specified in cell B1 of Project_DB Sheet
    strPath = ActiveWorkbook.Sheets("PAGE").Range("B2").Text
    strProv = "Microsoft.ACE.OLEDB.12.0;"
    strCn = "Provider=" & strProv & "Data Source=" & _
    strPath

    'Connection Open
    Cn.Open strCn
                
    strQry_IOCfg = "SELECT RackIOCfg.ModulePartNo, RackIOCfg.ModuleDesc FROM RackIOCfg" _
                & " WHERE RackIOCfg.Panel IN " & strCriteria _
                & " ORDER BY RackIOCfg.Panel;"
    
    rsQry_IOCfg.Open strQry_IOCfg, Cn
    
    Dim LastColumn As Integer, lastRow As Integer
    'Finds the last used cell in target wbk/sheet

    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With
    
    strQry_PNCfg = "SELECT RackCfg.RackPartNo, RackCfg.RackDesc FROM RackCfg" _
                & " WHERE RackCfg.Panel IN " & strCriteria _
                & " ORDER BY RackCfg.Panel;"
    
    rsQry_PNCfg.Open strQry_PNCfg, Cn
    
    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_PNCfg.DataSource
    End With
    
    Cn.Close
    
End Sub

1739212323052.png
 
Upvote 0
But the PNCfg is not working.

You must close the connection.

After these lines:
VBA Code:
    With ActiveWorkbook.Sheets("Sheet2")
      lastRow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
      .Range("A" & lastRow).CopyFromRecordset rsQry_IOCfg.DataSource
    End With

Add this line:
VBA Code:
Cn.Close

😇
 
Upvote 0

Forum statistics

Threads
1,226,466
Messages
6,191,196
Members
453,646
Latest member
SteenP

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top