How to create dependatn listboxes at runtime

[Nerisha]

Hi.
I have created a sheet that contains 3 listboxes. These are data validation lists that get created at runtime. It works well. But, I also have a column called "Associates" that is dependent on the "Customers" column. In other words, for each Customer, there are several Associates related to that Customer. The only way I could think of to get this to work, was to create the Associates list at runtime, on the Worksheet_change event, when the user selects a different Customer from the list. I managed to get that to work, (see code below), but it only works for the first row, as I named the cells in the first row. This entire sheet gets populated via code, and I cant name every row, so I need help on getting this right. Any ideas on what I can do here?


Private Sub Worksheet_Change(ByVal Target As Range)
Dim conn As Object
Dim rs As Object
Dim rs2 As Object
Dim ozConnStr As String
Dim sql As String
Dim sql2 As String
Dim CustName As String
Dim CustRef As String
Dim Item As String
Dim ItemRef As String
Set conn = CreateObject("ADODB.Connection")
ozConnStr = "DRIVER={MySQL ODBC 3.51 Driver};SERVER=tst01.habitaz.co.za;UID=oztech;PORT= 3306;DATABASE=oztech_test;USER=oztech;PASSWORD=fYb42248Z9;OPTION=3;"
conn.ConnectionString = ozConnStr
conn.Open
On Error GoTo ErrHandler:

If Target = Range("CustomerRefStart") Then
If Range("Associates") <> "" Then
Columns("Q:Q").Select
Selection.ListObject.QueryTable.Delete
Selection.ClearContents
Range("CustomerRefStart").Select
End If
CustRef = Range("CustomerRefStart")
sql = "SELECT Name FROM Customers WHERE CustomerRef = '" & CustRef & "'"
Set rs = CreateObject("ADODB.Recordset")
rs.Open sql, conn
If Not rs.EOF Then
CustName = rs!Name
End If
Range("CustomerName") = CustName
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:="ODBC;DATABASE=oztech_test;DSN=oztech_test;OPTION=0;;PORT=3306;SERVER=tst01.habitaz.co.za;UID=oztech", Destination:=Range("$Q$9")).QueryTable
.CommandText = Array( _
"SELECT CONCAT(Associates_0.FirstName,' ', Associates_0.LastName) " & Chr(13) & "" & Chr(10) & "FROM oztech_test.Associates Associates_0 LEFT JOIN o" _
, _
"ztech_test.Customers Customers_0 ON Customers_0.CustomerID = Associates_0.ObjectID AND Associates_0.ObjectClass = '" _
, "Customers' WHERE Customers_0.CustomerRef = '" & CustRef & "'")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = "Table_Query_from_oztech_test5"
.Refresh BackgroundQuery:=False
End With
ElseIf Target = Range("ItemReff") Then
ItemRef = Range("ItemReff")
sql2 = "SELECT ItemDescr FROM Items WHERE ItemRef = '" & ItemRef & "'"
Set rs2 = CreateObject("ADODB.Recordset")
rs2.Open sql2, conn
If Not rs2.EOF Then
Item = rs2!ItemDescr
End If
Range("ItemDescrip") = Item
ElseIf Target = Range("Quantity") Then
Quantity = Range("Quantity")
AmountExcl = Range("ItemAmtExcl")
AmountExcl = AmountExcl * Quantity
Range("AmtExcl").NumberFormat = "0.00"
Range("AmtExcl") = AmountExcl
AmountInc = Quantity * (Range("ItemAmtExcl") + (Range("ItemAmtExcl") * 0.14))
Range("AmtIncl").NumberFormat = "0.00"
Range("AmtIncl") = AmountInc
Range("AmtIncl").Select
Else
Range("C10").Select
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=$Q$10:$Q$1410"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
End If
ErrHandler:
Exit Sub

End Sub

 

[GlennUK]

Can't you have a set of ranges, one for each customer, of a list of Associates for each customer? Then an INDIRECT in the Data Validation will do all the work.

Examples of dynamic data validation here:
http://www.contextures.com/xldataval02.html