Question

I’m trying to create a dropdown that upon changing the selection from the list of options will run a query that will insert the query results into the page. Here’s what I have thus far:

    Sub DropDown1_Change()
   Dim dbConnect As String
   Dim leagueCode As String
   Dim leagueList As Range
   Dim leagueVal As String

   Dim TeamData As String

    Set leagueList = Worksheets("Menu Choices").Range("A5:A10")
    Set leagueVal = Worksheets("Menu Choices").Cell("B1").Value

    leagueCode = Application.WorksheetFunction.Index(leagueList, leagueVal)

    TeamData = "SELECT DISTINCT(Teams.teamID), name FROM Teams WHERE lgID = '" & leagueCode & "' & ORDER BY name ASC"

    With Worksheets("Menu Choices").QueryTables.Add(Connection:=dbConnect, Destination:=Worksheets("Menu Choices").Range("D5"))
        .CommandText = TeamData
        .Name = "Team List Query"
        .Refresh BackgroundQuery:=False
    End With

End Sub

Anywho have any suggestions to get it working? Thanks in advance!

Answer 1

I was able to resolve the issue using similar code to the following:

Sub createTeamList()
  Dim cn As New ADODB.Connection
  Dim rs As New ADODB.Recordset

  Dim SQL As String

  Dim inc As Integer

  Dim topCell As Range
  Dim leagueID As String

  Dim leagueList As Range
  Dim leagueChoice As Range

  Set leagueList = Worksheets("Menu Choices").Range("A4:A9")
  Set leagueChoice = Worksheets("Menu Choices").Range("B1")

  leagueID = Application.WorksheetFunction.Index(leagueList, leagueChoice)

  Set topCell = Worksheets("Menu Choices").Range("D4")

  With topCell
    Range(.Offset(1, 0), .Offset(0, 1).End(xlDown)).ClearContents
  End With

  With cn
    .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\lahman_57.mdb"
    .Provider = "Microsoft Jet 4.0 OLE DB Provider"
    .Open
  End With

  inc = 0

  SQL = "SELECT teamID, name " _
        & "FROM Teams " _
        & "WHERE lgID = '" & leagueID & "' " _
        & "GROUP BY teamID, name " _
        & "ORDER BY name "

  rs.Open SQL, cn

  With rs
      Do Until .EOF

         topCell.Offset(inc, 0) = .Fields("teamID")
         topCell.Offset(inc, 1) = .Fields("name")
         inc = inc + 1
         .MoveNext
      Loop
  End With

  rs.Close
  cn.Close
End Sub