Search code examples
excelvba

Getting column records from SQL server into excel dropdown list?


I am attempting to get my second column in sql server table [Pursuant] column "Landowner" rows into a drop-down list in cell B2 in my excel file. This code I have only seems to get the first record from my DB table: Any ideas how to get all of the records?

Sub PopulateDropdownList()
    Dim conn As Object
    Dim rs As Object
    Dim strConn As String
    Dim strSQL As String
    Dim ws As Worksheet
    Dim landownerNames As String
    Dim i As Integer
    Dim tempRange As Range

    ' Define the connection string
    strConn = "Provider=MSOLEDBSQL;Data Source=NICKS_LAPTOP;" & _
              "Initial Catalog=pursuant;Integrated Security=SSPI;"

    ' Create a new connection object
    Set conn = CreateObject("ADODB.Connection")

    ' Open the connection
    conn.Open strConn

    ' Create a new recordset object
    Set rs = CreateObject("ADODB.Recordset")

    ' Set a reference to the worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1")

    ' Set up a SQL query to retrieve distinct Landowner names from the SQL Server table
    strSQL = "SELECT DISTINCT Landowner FROM [Pursuant]"

    ' Execute the SQL query
    rs.Open strSQL, conn

    ' Concatenate Landowner names into a single string
    landownerNames = ""
    i = 0
    Do While Not rs.EOF
        If i > 0 Then
            landownerNames = landownerNames & ","
        End If
        landownerNames = landownerNames & rs.Fields(0).Value
        rs.MoveNext
        i = i + 1
    Loop

    ' Close the recordset
    rs.Close

    ' Close the connection
    conn.Close

    ' Clear existing data validation in cell B2
    ws.Range("B2").Validation.Delete

    ' Create a temporary range to hold the dropdown options
    Set tempRange = ws.Range("B2")

    ' Write the concatenated Landowner names to the temporary range
    tempRange.Value = Split(landownerNames, ",")

    ' Add data validation to cell B2 with the temporary range as the source
    With ws.Range("B2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:="=" & tempRange.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
End Sub

I am trying to create a template where a user can go into cell b2 in excel, select a landowner name and then that'll do a lookup to the other relevant data from sql server, but I need to get this dropdown list to populate first


Solution

  • Use another sheet to hold the list (it could be hidden)

    Option Explicit
    
    Sub PopulateDropdownList()
        Dim conn As Object
        Dim strConn As String, strSQL As String
        Dim lastrow As Long
        Dim ws As Worksheet
    
        ' Define the connection string
        strConn = "Provider=MSOLEDBSQL;Data Source=NICKS_LAPTOP;" & _
                  "Initial Catalog=pursuant;Integrated Security=SSPI;"
        
        ' Create a new connection object
        Set conn = CreateObject("ADODB.Connection")
    
        ' Open the connection
        conn.Open strConn
      
        ' Set up a SQL query to retrieve distinct Landowner names from the SQL Server table
        strSQL = "SELECT DISTINCT Landowner FROM [Pursuant]"
      
        ' Execute the SQL query
        With ThisWorkbook.Sheets("Sheet2")
           .Cells.Clear
           .Range("A1").CopyFromRecordset conn.Execute(strSQL)
           lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
    
        'Close the connection
        conn.Close
        
        ' Set a reference to the worksheet
        Set ws = ThisWorkbook.Sheets("Sheet1")
    
        ' Add data validation to cell B2 with the temporary range as the source
        With ws.Range("B2").Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:="=Sheet2!$A$1:$A$" & lastrow
            .IgnoreBlank = True
            .InCellDropdown = True
            .ShowInput = True
            .ShowError = True
        End With
       
    End Sub