Use SQL to fill Data Valadation list box

[Jeff1959]

What I have is a excel spreadsheet that tracks company sales projections. (I'm Farly new to VBA programing) I want to be able to select a companies name from a drop down box within the cell. Exactly like the data validation list box. The deference is I want to fill the box from an SQL database of companies, so that the list will always be current. I do know some ADO and I have been able to archive this by 1st bringing back the SQL query and inserting it on a workbook sheet as a range. Then accessing the range using the code below, but this seems to be the long way around. I was trying to modify the below code to use sql data but I have not been able to figure this out. Thanks for any suggestions.

I found this Code at Contextuers web site
It solves part of my problem but I couldn't figuer out how to plug an SQL string in to it.

[vba]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet
Cancel = True
Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
With cboTemp
'clear and hide the combo box
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
End With
On Error GoTo errHandler
If Target.Validation.Type = 3 Then
'if the cell contains a data validation list
Application.EnableEvents = False
'get the data validation formula
str = Target.Validation.Formula1
str = Right(str, Len(str) - 1)
With cboTemp
'show the combobox with the list
.Visible = True
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 5
.Height = Target.Height + 5
.ListFillRange = ws.Range(str).Address
.LinkedCell = Target.Address
End With
cboTemp.Activate
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
'=========================================
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim str As String
Dim cboTemp As OLEObject
Dim ws As Worksheet
Set ws = ActiveSheet

Set cboTemp = ws.OLEObjects("TempCombo")
On Error Resume Next
If cboTemp.Visible = True Then
With cboTemp
.Top = 10
.Left = 10
.ListFillRange = ""
.LinkedCell = ""
.Visible = False
.Value = ""
End With
End If

errHandler:
Application.EnableEvents = True
Exit Sub

End Sub
'====================================
'Optional code to move to next cell if Tab or Enter are pressed
'from code by Ted Lanham
Private Sub TempCombo_KeyDown(ByVal _
KeyCode As MSForms.ReturnInteger, _
ByVal Shift As Integer)
Select Case KeyCode
Case 9 'Tab
ActiveCell.Offset(0, 1).Activate
Case 13 'Enter
ActiveCell.Offset(1, 0).Activate
Case Else
'do nothing
End Select
End Sub
'====================================


[/vba]

[Bob Phillips]

I am confused by what is a data validation list and hat is a combobox, and why.

You can load the list like so

[vba]

If Not RS.EOF Then
ary = Application.Transpose(Application.Transpose(RS.getrows))
With Range("F1").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(ary, ",")
End With
End If
[/vba]

[Jeff1959]

The data validation List is part of Excels built in functions, it uses a type of combo box to list data. Only data in that list can be inserted to the cell. Im not sure what the code you supplied is doing, as I said I'm new to VBA.
Thanks

[IMG]file:///C:/Users/jod/AppData/Local/Temp/moz-screenshot.jpg[/IMG]

[Bob Phillips]

I meant in your code, I know what DV and a combobox is, what I don't understand is what your code is doing with both.

Your code is referring to both, but DV is NOT a combobox. So what is going on in that SelectionChange event, you wrote it?

The code I gave you will take the recordest from your SQL and poulate a DV in cell F1 with the results.

[Jeff1959]

Thank you for the excellent Help, Just before your reply I figured out were you were going with your code "It works great"(I'm such a beginner). However there’s one problem. The code runs perfectly but when I save the workbook and re-open it I get the following error and excel removes the data validation reference. I'm running excel 2007 could that be an issue?

Below is my final code and below that is the Error.
Thanks





[vba]
Private Sub Worksheet_Activate()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sSQL As String
sSQL = "SELECT C.Customer " & _
"FROM Production.dbo.Customer as C"
Set rs = New ADODB.Recordset
Set cmd = New ADODB.Command
Set cnn = New ADODB.Connection
cnn.ConnectionString = "PROVIDER=SQLOLEDB.1;PERSIST SECURITY INFO=FALSE;" & _
"INITIAL CATALOG=XXX_Labor;" & _
"DATA SOURCE=xxxxxxx\xxxxxx;" & _
"User ID=XXXXXXX_User;" & _
"Password=" & "XXXX_!user"
rs.Open sSQL, cnn.ConnectionString, adOpenStatic
If Not rs.EOF Then
ary = Application.Transpose(Application.Transpose(rs.GetRows))
With Range("A5:A500").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=Join(ary, ",")
End With
End If
End Sub
[/vba]

ERROR
Removed Feature: Data validation from /xl/worksheets/sheet2.xml part

[Jeff1959]

XLD Thank you for all your help!!!

I figured a work around for the Error by putting this in the Workbook_BeforeClose module and moving my original code to the Workbook_Open module. Not sure why the error.

[vba]
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Sheets("Test").Select
With Range("A5:A500").Validation
.Delete
.Add Type:=xlValidateList, Formula1:=" "
End With
End Sub
[/vba]