Populate ComboBox With Unique Values From Column In Excel 1

[VBAjedi]

I need to populate MyComboBox on MyForm with a list of the unique values from the visible cells in column "A". I've played around with the MyComboBox.List property in conjunction with Range("A:A&quot.SpecialCells(xlCellTypeVisible) , but can't seem to get it to work. Any ideas?

Thanks!

VBAjedi

 

[RobBroekhuis]

Probably easiest to generate a list in array form first, then populate the combobox from the array. Crudely:

items=0
for each cell in range("A&quot.specialcells(xlCellTypeVisible)
i=1
do while i<=items and item(i)<>cell
i=i+1
loop
if item(i)<>cell then
items=items+1
item(items)=cell
end if
next cell
for i=1 to items
MyForm.MyCombobox.additem item(i)
next i

Instead of the last three lines, I think you can also simply assign the array to the .list property of the combobox, although I've not tried that myself.
Rob

 

[VBAjedi]

Rob,

Thanks! That works. I'm not very happy with the big picture on this one, though. I'm trying to make a form that does complex filtering that may be beyond the scope of Excel's Autofilter and Advanced Filter. (i.e. &quot;Show me all the rows where these four columns match these four values, this column matches either of these values, and this column's value is between these two values.&quot; I'm thinking about trying SQL queries instead.

Know any good resources on integrating SQL statements with VBA?

Thanks for the help! A star is in order. . .

VBAjedi

 

[RobBroekhuis]

I can't help with the SQL angle. I think what you're trying to do may still be feasible using advanced filter, but I guess it depends on how flexibly you need to be able to implement the queries.
Rob

 

[xlbo]

Don't know a great deal about SQL in excel but I DO know that you can create the SQL as a string and use the ADO / DAO objects (open recordset etc) with the SQL string to create a query

Here's an example from typing &quot;recordset&quot; into help:
This example uses the CreateQueryDef and OpenRecordset methods and the SQL property to query the table of titles in the Microsoft SQL Server sample database Pubs and return the title and title identifier of the best-selling book. The example then queries the table of authors and instructs the user to send a bonus check to each author based on his or her royalty share (the total bonus is $1,000 and each author should receive a percentage of that amount).

Sub ClientServerX2()

Dim dbsCurrent As Database
Dim qdfBestSellers As QueryDef
Dim qdfBonusEarners As QueryDef
Dim rstTopSeller As Recordset
Dim rstBonusRecipients As Recordset
Dim strAuthorList As String

' Open a database from which QueryDef objects can be
' created.
Set dbsCurrent = OpenDatabase(&quot;DB1.mdb&quot

' Create a temporary QueryDef object to retrieve
' data from a Microsoft SQL Server database.
Set qdfBestSellers = dbsCurrent.CreateQueryDef(&quot;&quot

With qdfBestSellers
.Connect = &quot;ODBC;DATABASE=pubs;UID=sa;PWD=;&quot; & _
&quot;DSN=Publishers&quot;
.SQL = &quot;SELECT title, title_id FROM titles &quot; & _
&quot;ORDER BY ytd_sales DESC&quot;
Set rstTopSeller = .OpenRecordset()
rstTopSeller.MoveFirst
End With

' Create a temporary QueryDef to retrieve data from
' a Microsoft SQL Server database based on the results from
' the first query.
Set qdfBonusEarners = dbsCurrent.CreateQueryDef(&quot;&quot

With qdfBonusEarners
.Connect = &quot;ODBC;DATABASE=pubs;UID=sa;PWD=;&quot; & _
&quot;DSN=Publishers&quot;
.SQL = &quot;SELECT * FROM titleauthor &quot; & _
&quot;WHERE title_id = '&quot; & _
rstTopSeller!title_id & &quot;'&quot;
Set rstBonusRecipients = .OpenRecordset()
End With

' Build the output string.
With rstBonusRecipients
Do While Not .EOF
strAuthorList = strAuthorList & &quot; &quot; & _
!au_id & &quot;: $&quot; & (10 * !royaltyper) & vbCr
.MoveNext

Loop
End With

' Display results.
MsgBox &quot;Please send a check to the following &quot; & _
&quot;authors in the amounts shown:&quot; & vbCr & _
strAuthorList & &quot;for outstanding sales of &quot; & _
rstTopSeller!Title & &quot;.&quot;

rstTopSeller.Close
dbsCurrent.Close

End Sub Rgds
Geoff

Si hoc legere scis, nimis eruditionis habes