List Box Possible Bug??

[skinicod]

I have a listbox that contains a list of values which when selected sets off an ADODB sql command to the database and populates another listbox in the form based on the values selected in the first listbox.

This all works fine and dandy when a user is using the mouse to select the value/values they want. However if a user uses the arrow keys to move up and down the first list box, the data that appears in the second listbox corresponds to the previous item selected in the first list box - ie there is a one item lag.

Does anyone know if there is a way round this or is it a bug??

 

[GHolden]

Hi, what event are you using to trigger the population of the second listbox?



There are two ways to write error-free programs; only the third one works.

 

[skinicod]

Hi,

I am currently using the click event on the first listbox to trigger the population of the second

 

[GHolden]

Hi,

Odd. I have just set up a quick test with two listboxes, I have the following code in the onclick event of the first listbox and it works for either mouse click or cursor keys...

lstTwo.RowSource = "SELECT SupplierID,Supplier " & _
"FROM tblSupplier " & _
"WHERE SupplierID = " & lstOne.Column(2)

There are two ways to write error-free programs; only the third one works.

 

[skinicod]

I only get the problem when the multiselct property is set to extended. Also am using RowSourceType to populate the listbox with an array - Don't know if this makes any difference??

 

[GHolden]

Can you post the actual code you are using?



There are two ways to write error-free programs; only the third one works.

 

[skinicod]

Sorry about the amount of code!!

lstfield is the first listbox
mylist is the field being populated
lsttab is another listbox whose selections are called upon
CkFldAll and CkTabAll are just tick boxes (they would normally be set to false)

Hope you can help,

Cheers...


Private Sub LstField_Click()
DoCmd.Hourglass True
If CkFldAll = False Then LstFldFunc
DoCmd.Hourglass False
End Sub

Sub LstFldFunc()
Dim varItm As Variant
Dim strfld As String
Dim StrTab As String

On Error GoTo ErrorDo

MyList.Enabled = True

Info1.Caption = "No Item Selected"
Info1.ForeColor = RGB(0, 0, 0)
Info2.Caption = "No Item Selected"
Info2.ForeColor = RGB(0, 0, 0)
Info5.Caption = "No Item Selected"
Info5.ForeColor = RGB(0, 0, 0)

If obRecordset.State = 1 Then obRecordset.Close
MyList.RowSource = "BlankImport"

strfld = "''"
For Each varItm In LstField.ItemsSelected
strfld = strfld & ", '" & LstField.Column(0, varItm) & "'"
Next varItm

If strfld = "''" Then
MyList.Enabled = False
GoTo NotError
End If

GeneralSub

GoTo NotError

ErrorDo:

MsgBox "An Error Has Occurred", vbCritical, "Warning"
DoCmd.Hourglass False

NotError:
End Sub


Sub GeneralSub()
Dim strfld As String
Dim StrTab As String
Set connection = New ADODB.connection
connection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & CurrentDb.Name & ";"

If CkFldAll = False Then
strfld = "''"
For Each varItm In LstField.ItemsSelected
strfld = strfld & ", '" & LstField.Column(0, varItm) & "' "
Next varItm
Else
strfld = "All"
End If

If CkTabAll = False Then
StrTab = "''"
For Each varItm In LstTab.ItemsSelected
StrTab = StrTab & ", '" & LstTab.Column(0, varItm) & "' "
Next varItm
Else
StrTab = "All"
End If

If StrTab = "All" Then
If strfld = "All" Then
If SumVar = "X" Then
obRecordset.Open "SELECT * from audit" & Suffix, connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

Else
obRecordset.Open "SELECT * from audit" & Suffix & " " & SumVar2, connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

End If
Else
If SumVar = "X" Then
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".name in(" & strfld & &quot", connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

Else
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".name in(" & strfld & &quot " & SumVar, connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

End If
End If
Else
If strfld = "All" Then
If SumVar = "X" Then
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".table in(" & StrTab & &quot", connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

Else
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".table in(" & StrTab & &quot " & SumVar, connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

End If
Else
If SumVar = "X" Then
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".table in(" & StrTab & &quot and audit" & Suffix & ".name in(" & strfld & &quot", connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

Else
obRecordset.Open "SELECT * from audit" & Suffix & " where audit" & Suffix & ".table in(" & StrTab & &quot and audit" & Suffix & ".name in(" & strfld & &quot " & SumVar, connection, adOpenForwardOnly, adLockReadOnly
FillMyList
obRecordset.Close
MyList.RowSourceType = "SasImport"

End If
End If
End If

For Each varItm In MyList.ItemsSelected
StrTst = MyList.Column(0, varItm)
Info1.Caption = MyList.Column(0, varItm)
Info1.ForeColor = RGB(200, 0, 0)
Info2.Caption = MyList.Column(1, varItm)
Info2.ForeColor = RGB(200, 0, 0)
Info5.Caption = MyList.Column(4, RSPos)
Info5.ForeColor = RGB(200, 0, 0)
Next varItm

If StrTst = Empty Then
Info1.Caption = "No Item Selected"
Info1.ForeColor = RGB(0, 0, 0)
Info2.Caption = "No Item Selected"
Info2.ForeColor = RGB(0, 0, 0)
Info5.Caption = "No Item Selected"
Info5.ForeColor = RGB(0, 0, 0)
End If
connection.Close
End Sub



Function SasImport(fld As Control, id As Variant, row As Variant, col As Variant, code As Variant) As Variant
Dim test As String
Select Case code
Case acLBInitialize
SasImport = True
Case acLBOpen
SasImport = 1
Case acLBGetRowCount
SasImport = RsCnt
Case acLBGetColumnCount
SasImport = 9
Case acLBGetColumnWidth
Select Case col
Case 0
SasImport = 0
Case 1
SasImport = 0
Case 2
SasImport = "6cm"
Case 3
SasImport = "3cm"
Case 4
SasImport = 0
Case 5
SasImport = "3cm"
Case Else
SasImport = 0
End Select
Case acLBGetValue
On Error GoTo ErrorPart
Select Case col
Case 0
SasImport = MyList1(row)
Case 1
SasImport = MyList2(row)
Case 2
SasImport = MyList3(row)
Case 3
SasImport = MyList4(row)
Case 4
SasImport = MyList5(row)
Case 5
SasImport = Format(MyList6(row), "0.00%&quot
End Select
GoTo NextPart
ErrorPart:
SasImport = ""
NextPart:
RSPos = row
End Select
End Function

 

[skinicod]

correction - mylist is the listbox being populated

 

[skinicod]

just noticed the fillmylist procedure was missing from the code I posted...

Sub FillMyList()
i = 0
While Not (obRecordset.BOF Or obRecordset.EOF)
ReDim Preserve MyList1(i)
ReDim Preserve MyList2(i)
ReDim Preserve MyList3(i)
ReDim Preserve MyList4(i)
ReDim Preserve MyList5(i)
ReDim Preserve MyList6(i)
For k = 1 To 9
Select Case k
Case 1
MyList1(i) = obRecordset.Fields(k)
Case 2
MyList2(i) = obRecordset.Fields(k)
Case 3
MyList3(i) = obRecordset.Fields(k)
Case 4
MyList4(i) = obRecordset.Fields(k)
Case 5
MyList5(i) = obRecordset.Fields(k)
Case 9
MyList6(i) = obRecordset.Fields(k)
End Select
Next k
obRecordset.MoveNext
i = i + 1
Wend
RsCnt = i
If RsCnt = 0 Then
MyList.Enabled = False
Else
MyList.Enabled = True
End If
End Sub

 

[GHolden]

Okay,

I'm having a look, may take a while to work out exactly what's happening...



There are two ways to write error-free programs; only the third one works.

 

[skinicod]

Cheers

 

[GHolden]

Hi,

Sorry for the delay in response. I can't find any obvious cause to the syptoms you are discribing. But to be perfectly honest I can't completely follow the code that you are using.

Appologies for any time wasted.



There are two ways to write error-free programs; only the third one works.

 

[skinicod]

thank anyway