Ask Me Help Desk

Ask Me Help Desk (https://www.askmehelpdesk.com/forum.php)
-   Spreadsheets (https://www.askmehelpdesk.com/forumdisplay.php?f=395)
-   -   Pulling multiple parameter queries into excel using VB (https://www.askmehelpdesk.com/showthread.php?t=612674)

  • Nov 16, 2011, 08:40 AM
    chaserracer83
    Pulling multiple parameter queries into excel using VB
    Hi, I have a project where I would like to pull information from multiple parameter queries using cells in a worksheet. My VB skills are not great, but I have been able to use code found on other forums to pull from a single query. The problem is when I try to add another query to my code it only pulls from the first query.

    I am attaching two sets of code below… the first is the working code that pulls form a single query, the second is me adding code to try and pull from an additional query (does not work). The code includes turning off calculations while the import is being done and then turning them back on once the import is complete.

    If anyone is able to help me figure out how to make this work it would be a huge lifesaver.

    FIRST SET OF CODE, WORKS PULLING IN A SINGLE PARAMETER QUERY:

    Sub GoToManual()

    Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error Go to CalcBack

    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim I As Integer

    Set MyDatabase = DBEngine.OpenDatabase _
    ("H:\Dashboard\ManifestData.mdb")
    Set MyQueryDef = MyDatabase.QueryDefs("ManifestAnalysis")

    With MyQueryDef
    .Parameters("[Origin:]") = Range("D5").Value
    End With

    Set MyRecordset = MyQueryDef.OpenRecordset

    Sheets("All Data - CY").Select
    ActiveSheet.Range("A6:K999999").ClearContents

    ActiveSheet.Range("A2").CopyFromRecordset MyRecordset

    For i = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
    Next i

    MsgBox "The station data has been added to the workbook. Please hit OK and allow time for the calcualtions to process."

    Application.Calculation = xlCalc
    Exit Sub
    CalcBack:
    Application.Calculation = xlCalc
    End Sub

    SECOND SET OF CODE, MEANT TO PULL IN TWO PARAMETER QUERIES BUT ONLY PULLS IN ONE:

    Sub GoToManual()

    Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error Go to CalcBack

    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim I As Integer

    Set MyDatabase = DBEngine.OpenDatabase _
    ("

    Application.Calculation = xlCalc
    Exit Sub
    CalcBack:
    Application.Calculation = xlCalc
    End Sub

    SECOND SET OF CODE, MEANT TO PULL IN TWO PARAMETER QUERIES BUT ONLY PULLS IN ONE:

    Sub GoToManual()

    Dim xlCalc As XlCalculation
    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    On Error GoTo CalcBack

    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim i As Integer

    Set MyDatabase = DBEngine.OpenDatabase _
    (")
    Set MyQueryDef = MyDatabase.QueryDefs(")
    Set MyQueryDef = MyDatabase.QueryDefs(")

    With MyQueryDef
    .Parameters("[Origin:]")

    With MyQueryDef
    .Parameters("D5") = Range("All Data - CY").Value
    End With

    Set MyRecordset = MyQueryDef.OpenRecordset

    Sheets("A6:K999999").Select
    ActiveSheet.Range("A2").CopyFromRecordset MyRecordset

    For I = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(1, I).Value = MyRecordset.Fields(I - 1).Name
    Next I

    Set MyDatabase = DBEngine.OpenDatabase _
    (").ClearContents

    ActiveSheet.Range(")
    Set MyQueryDef = MyDatabase.QueryDefs("ManifestAnalysisTwo").CopyFr omRecordset MyRecordset

    For i = 1 To MyRecordset.Fields.Count
    ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
    Next i

    Set MyDatabase = DBEngine.OpenDatabase _
    ("[Origin:]")
    Set MyQueryDef = MyDatabase.QueryDefs("D5")

    With MyQueryDef
    .Parameters("Station Data - CY") = Range("A6:K999999").Value
    End With

    Set MyRecordset = MyQueryDef.OpenRecordset

    Sheets("A2").Select
    ActiveSheet.Range("The station data has been added to the workbook. Please hit OK and allow time for the calcualtions to process."

    Application.Calculation = xlCalc
    Exit Sub
    CalcBack:
    Application.Calculation = xlCalc
    End Sub
  • Nov 16, 2011, 09:22 AM
    JBeaucaire
    You appear to have used the same Origin value from D5. That's fine, except the second part you aren't ON the same sheet you started from. So you do need to include a sheet reference to make sure the D5 is taken from the correct sheet. What I did was was NOT move to the second sheet, instead I showed you how to send commands to the CY sheet without "selecting it" first.

    Next, you didn't change anything in the second second set of code regarding where the data is inserted. Cells(1, i) equals A1 then first time through the for/next loop, then B1, C1, etc. So you're putting the values into row1. The second time through the loop you need to put the values in row2.

    So, I'd tweak your macro down as shown to retain the origin D5 value and put the second query results in row 2.

    Code:

    Sub GoToManual()
    Dim xlCalc As XlCalculation
    Dim MyDatabase As DAO.Database
    Dim MyQueryDef As DAO.QueryDef
    Dim MyRecordset As DAO.Recordset
    Dim i As Long

    xlCalc = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    On Error GoTo CalcBack

    Set MyDatabase = DBEngine.OpenDatabase("H:\Dashboard\ManifestData.mdb")
    Set MyQueryDef = MyDatabase.QueryDefs("ManifestAnalysis")
    MyQueryDef.Parameters("[Origin:]") = Sheets("Sheet1").Range("D5").Value
    Set MyRecordset = MyQueryDef.OpenRecordset

    With Sheets("All Data - CY")
        .Range("A6:K" & .Rows.Count).ClearContents
        .Range("A2").CopyFromRecordset MyRecordset

        For i = 1 To MyRecordset.Fields.Count
            .Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
        Next i

        Set MyQueryDef = MyDatabase.QueryDefs("ManifestAnalysisTwo")

        MyQueryDef.Parameters("[Origin:]") = Sheets("Sheet1").Range("D5").Value 'is this needed?
        Set MyRecordset = MyQueryDef.OpenRecordset

        .Range("A2").CopyFromRecordset MyRecordset  'does this need to be adjusted? A2 is still right?

        For i = 1 To MyRecordset.Fields.Count      'this puts results in row2
            .Cells(2, i).Value = MyRecordset.Fields(i - 1).Name
        Next i

    End With

    MsgBox "The station data has been added to the workbook. Please hit OK and allow time for the calculations to process."

    CalcBack:
        Application.Calculation = xlCalc
        Application.ScreenUpdating = True
    End Sub


    The tweaks may be wrong, but they're meant to get you looking at your code in terms of what it DOES to your sheet, where it puts things. You can't "clear contents" twice and wonder where half the data went, you cleared it! You can't put data in the same place twice and wonder where half the data is... you wrote over the top of it. You must change something the second/third times through to make sure your new data is being added below the first set.
  • Nov 16, 2011, 10:26 AM
    chaserracer83
    Ah ha! Thank you so much!

    I was clearing and pasting the different data sets into different sheets so that wasn't an issue.

    You hit the nail on the head when you said "You appear to have used the same Origin value from D5. That's fine, except the second part you aren't ON the same sheet you started from". I left the origin sheet so when it came time to pass the parameter to the second query it was pulling from the wrong sheet.

    The issue was fixed by changing:

    With MyQueryDef
    .Parameters("[Origin:]") = Range("D5").Value
    End With

    to:

    With MyQueryDef
    .Parameters("[Origin:]") = Sheets("Welcome").Range("D5").Value
    End With

    Thank you JB for your help. I never would have thought of that.

  • All times are GMT -7. The time now is 04:18 PM.