Can I have more than one list boxes on a Sheet?

[Nerisha]

Hi there,

I have created a data validation listbox on a sheet. This allows me to select an item on the list, and when I change the item, I put code on the "Worksheet_change" event to update the value of the item. Now, I need to add more listboxes to the same sheet. How can I make this possible?

 

[Richard Schollar]

Hi

Do you mean that you want Validation to apply to eg separate columns (say you have it in A1 at the monet, you want another validation in B1, C1 etc) and based on changes to these cells, update the relevant list that feeds the Validation? If so, you can do it like this:

Private Sub Worksheet_Change(byVal Target As Range)
 
On Error Goto exit_here
If Target.Count = 1 Then
If Target.Row = 1 Then
Application.EnableEvents = False
Select Case Target.Column
Case 1
'so A1 changed - do amendment code to A column list
Case 2
'so B1 changed - do amendment code to B column list
Case 3
'etc etc
Case Else
'whatever you want to happen if specific columns not changed
End Select
End if
End if
 
exit_here:
Application.EnableEvents = True
End Sub

 

[Nerisha]

I have the following code added, but it does not seem to work:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim conn As Object
Dim rs As Object
Dim ozConnStr As String
Dim rs2 As Object
Dim sql As String
Dim sql2 As String
Dim CustName As String
Dim CustRef As String
Dim ItemRef As String
Dim Item As String

On Error GoTo exit_here
If Target.Count = 1 Then
If Target.Row = 10 Then
Application.EnableEvents = False
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
Select Case Target.Column
Case 1
If Target = Range("CustomerRefStart") Then
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("B10") = CustName

Case 4
ItemRef = Range("D10")
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("E10") = Item

End Select
End If
End If


Am I doing something wrong?
exit_here:
Application.EnableEvents = True
End Sub

 

[Richard Schollar]

Can you describe in words what the following is meant to be doing (ie what you want it to do):

If Target = Range("CustomerRefStart") Then

 

[Nerisha]

Its ok. I used an "if" statement instead of a Select statement, and it worked. The only problem now is that after the code executes, it remains in the VBA code, and not on the datasheet view. Is there a way that I can view the datasheet view programiatically?

 

[Richard Schollar]

I'm sorry but i don't understand - what do you mean when you say "it remains in the VBA code"?

The code should execute when you make your changes and should amend the ranges specified.

 

[Nerisha]

I have to physically press "Alt + F11" to bring it back to datasheet view each time.

 

[Richard Schollar]

Have you placed any breakpoints in the code? Otherwise, the VBE shouldn't be activating when the code runs

 

[Norie]

Nerisha

Try clearing all breakpoints and closing the VBE window.

If it still goes to the code then there must be something else going on.

Do you get any error messages, options to Debug/End/Continue or any code highlighted?

 

[Nerisha]

I've tried all of that. It still opens up in the VB Editor.

The last piece of code that it executes it this:

Sub CreateEventProcedure()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Sheet88")
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CreateEventProc("Change", "Worksheet")
LineNum = LineNum + 1
.InsertLines LineNum, "End If "
.InsertLines LineNum, " Range(" & DQUOTE & "ItemDescrip" & DQUOTE & ") = Item"
.InsertLines LineNum, " End If"
.InsertLines LineNum, " Item = rs2!ItemDescr"
.InsertLines LineNum, " If Not rs2.EOF Then"
.InsertLines LineNum, " rs2.Open sql2, conn"
.InsertLines LineNum, " Set rs2 = CreateObject(" & DQUOTE & "ADODB.Recordset" & DQUOTE & ")"
.InsertLines LineNum, " sql2 = " & DQUOTE & "SELECT ItemDescr FROM Items WHERE ItemRef = '" & DQUOTE & "& ItemRef & " & DQUOTE & "'"
.InsertLines LineNum, " ItemRef = Range(" & DQUOTE & "ItemReff" & DQUOTE & " ) "
.InsertLines LineNum, "ElseIf Target = Range(" & DQUOTE & "ItemReff" & DQUOTE & ") Then"
.InsertLines LineNum, " Range(" & DQUOTE & "CustomerName" & DQUOTE & ") = CustName"
.InsertLines LineNum, " End If"
.InsertLines LineNum, " CustName = rs!name"
.InsertLines LineNum, " If Not rs.EOF Then"
.InsertLines LineNum, " rs.Open sql, conn"
.InsertLines LineNum, " Set rs = CreateObject(" & DQUOTE & "ADODB.Recordset" & DQUOTE & ")"
.InsertLines LineNum, " sql = " & DQUOTE & "SELECT Name FROM Customers WHERE CustomerRef = '" & DQUOTE & "& CustRef & " & DQUOTE & "'"
.InsertLines LineNum, " CustRef = Range(" & DQUOTE & "CustomerRefStart" & DQUOTE & ")"
.InsertLines LineNum, " If Target = Range(" & DQUOTE & "CustomerRefStart" & DQUOTE & ") Then"
.InsertLines LineNum, " conn.Open"
.InsertLines LineNum, " conn.ConnectionString = ozConnStr"
.InsertLines LineNum, " ozConnStr = " & DQUOTE & "DRIVER={MySQL ODBC 3.51 Driver};SERVER=tst01.habitaz.co.za;UID=oztech;PORT= 3306;DATABASE=oztech_test;USER=oztech;PASSWORD=fYb42248Z9;OPTION=3; & DQUOTE & """
.InsertLines LineNum, " Set conn = CreateObject(" & DQUOTE & "ADODB.Connection" & DQUOTE & ")"
.InsertLines LineNum, " Dim ItemRef As String"
.InsertLines LineNum, " Dim Item As String"
.InsertLines LineNum, " Dim CustRef As String"
.InsertLines LineNum, " Dim CustName As String"
.InsertLines LineNum, " Dim sql2 As String"
.InsertLines LineNum, " Dim sql As String"
.InsertLines LineNum, " Dim ozConnStr As String"
.InsertLines LineNum, " Dim rs2 As Object"
.InsertLines LineNum, " Dim rs As Object"
.InsertLines LineNum, " Dim conn As Object"
End With
End Sub

Could that be the problem?