Combo box from table with large number of records 1

[ChristinaFC]

I have a number of comboboxes in my forms linking to a table with ~40.000 records. As this tends to make the loading of the forms rather slow I tried Allen Brownes approach where the rowsource only loads after the first three letters have been typed into the box, but cannot get it to work. I must admit I do not understand his code to 100%, so it might be that something has gone wrong in my adaptation.

Unfortunately I was not up to speed with naming conventions when creating the database, but hopefully it is still understandable.

Allen Browne's original code can be found at

http://allenbrowne.com/ser-32.html

The combobox has the following properties
name - cboFöretagsnamn
Controlsource - OrgnrID
Rowsource - blank
Rowsource Type - blank
Bound Column - 1
Column Count - 1

The Form which conatains the combobox is called frmÖversiktAvProjekt and has Recordset Type - Dynaset

The table Företag contains the fields OrgnrPID and Företagsnamn

When running the form, I see the values for the existing records in the combobox, but when adding new records, after having typed three figures the drop downbox still remain blank. What am I doing wrong?

The code:
Option Compare Database
Option Explicit

'Makes company name load to combobox when three letters are typed into the box
Dim strFtgsnamnStub As String
Const conFtgsnamnMin = 3
Function ReloadcboFöretagsnamnInfo(OrgnrID As String)
Dim strNewStub As String ' First chars of OrgnrID

'You can use the Nz function to return zero, a zero-length string (" "), or another specified value when a Variant is Null. expression.Nz(Value, ValueIfNull)
strNewStub = Nz(Left(OrgnrID, conFtgsnamnMin), "")
' If first n chars are the same as previously, do nothing.
If strNewStub <> strFtgsnamnStub Then
If Len(strNewStub) < conFtgsnamnMin Then
'Remove the RowSource
Me.cboFöretagsnamn.RowSource = "SELECT OrgnrPID FROM Företag WHERE (false) ;"
strFtgsnamnStub = ""
Else
'New RowSource
Me.cboFöretagsnamn.RowSource = "SELECT OrgnrPID FROM Företag WHERE (OrgnrPID Like """ & _
strNewStub & "*"");"
strFtgsnamnStub = strNewStub
End If
End If
End Function

Private Sub cboFöretagsnamn_Change()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn, ""))
End Sub

Private Sub frmÖversiktAvProjekt_Current()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn, ""))
End Sub

 

[MajP]

I will have to look in detail, but at a minimum:
change
Private Sub frmÖversiktAvProjekt_Current()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn, ""))
End Sub

to
Private Sub Form_Current()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn, ""))
End Sub

 

[MajP]

Also as far as I can tell this will do nothing unless you change

Private Sub cboFöretagsnamn_Change()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn, ""))
End Sub

to

Private Sub cboFöretagsnamn_Change()
Call ReloadcboFöretagsnamnInfo(Nz(Me.cboFöretagsnamn.text, ""))
End Sub

 

[MajP]

Also you might want to add a line of code to drop down the list

'New RowSource
Me.cboFöretagsnamn.RowSource = "SELECT OrgnrPID FROM Företag WHERE (OrgnrPID Like """ & _
strNewStub & "*"");"
me..cboFöretagsnamn.dropdown

 

[ChristinaFC]

Thanks MajP for helping out on this!

However, it still does not seem to work. I still get no values in the dropdown-box.

Also, when adding the code to shop the drop down list automatically I get the following error message wen switching to a new record (but not when adding a new record): "run-time error '2185': You can't reference a property or method for a control unless the control has the focus", so for now I have exluded that part of code.

I attach an extract from my database, in case that makes it easier to figure out what I am doing wrong (this is making me crazy - especially as it is a function that could speed up my database quite a bit, should I get it to work).

 

[MajP]

You can not use "like" on a numeric field. So you will have to convert the field in your row source.
See demo

http://www.4shared.com/file/186712847/ddc4a40/_CF_database_test_2010.html

You will have to type 6 characters because you gave me a set that had the first 5 the same

However, I would not do it this way. You should NEVER make and ID numeric unless it is truly numeric. Definately do not make it a double and then apply a text format 0000-0000. Do you plan to add, subtract, multiply, divide etc on the ID? Probably not. It is simply a string with only numeric characters. To save yourself a lot of pain in other locations change this to a text field. You will have to break the relationships first. Then convert the field in the table design. Then the original code should work fine. I would strongly recommend converting to text, especially if you plan to use formatting.

 

[MajP]

Also the demo shows how to fix the drop down error.

 

[ChristinaFC]

Super, many thanks!

 

[MajP]

http://www.4shared.com/file/186798103/3ec1db77/CFver2.html

I think I would do something more like this. It would be a little faster and simpler.

 

[ChristinaFC]

Wonderful, it works like a charm!
I chose to use the first alternative as I have a huge number of records so the field lstrange would become too long.
I put the code in a module and calls it from the form. For form current I chose to insert the result of the sub directly instead of going through the full sub (I called it a sub, am not really sure whether it is a sub or a function).
My only outstanding problem now is that when using this in a continuous form, only the first form load show a value in the combobox, the others remain blank until I click on them (and thus make them current). Is there an Event similar to Current, which makes the calculation for all visible records in continuous forms?

This is the code as it stands now (I have now added the complexity that it is another field, Listaftg, which contains the text being shown, and is what is typed in, but it is the field OrgnrID which is stored):

'Makes company name and OrgnrID load to combobox when three letters are typed into the box
Sub ReloadcboListaFtg(OrgnrID As String)
Dim strNewStub As String ' First chars of OrgnrID
Dim strFtgsnamnStub As String
Const conFtgsnamnMin = 3
'You can use the Nz function to return zero, a zero-length string (" "), or another specified value when a Variant is Null. expression.Nz(Value, ValueIfNull)
strNewStub = Nz(Left(OrgnrID, conFtgsnamnMin), "")
' If first n chars are the same as previously, do nothing.
If strNewStub <> strFtgsnamnStub Then
If Len(strNewStub) < conFtgsnamnMin Then
'Remove the RowSource
Me.cboFöretagsnamn.RowSource = "SELECT ListaFtg, OrgnrPID FROM qryFtgsLista WHERE (false) ;"
strFtgsnamnStub = ""
Else
'New RowSource
Me.cboFöretagsnamn.RowSource = "SELECT ListaFtg, OrgnrPID FROM qryFtgsLista WHERE (ListaFtg Like """ & strNewStub & "*"") ORDER BY ListaFtg"
strFtgsnamnStub = strNewStub
Me.cboFöretagsnamn.Dropdown
End If

End If
End Sub


Private Sub cboFöretagsnamn_Change()
Call ReloadcboListaFtg(Nz(Me.cboFöretagsnamn.Text, ""))
End Sub

Private Sub form_current()
Me.cboFöretagsnamn.RowSource = "SELECT ListaFtg, OrgnrPID FROM qryFtgsLista WHERE qryFtgsLista.OrgnrPID = OrgnrID"
End Sub

 

[MajP]

No there is no event that can do this, and there is no easy way to do this, that I can think of. I could do this but it would be very complicated. The problem is not the event it is in a continous form where you change the rowsource of the combobox. If the bound value of the record is not in the rowsource then it will not display. One trick is to lay a textbox over top of the combo and just show the down arrow of the combo. You select from the combo but use the textbox to display your info. So in your case the textbox would show listFtg, but the combo is bound to orgnrID. In your case this will not work since you need to be able to type into the combo.

If you wanted to go with that solution, then in your case you would have to probably have a another unbound textbox to type your filter. Personally, I find this interface very clumsy. I would redesign the whole approach. I would use either a textbox or another control to filter the rowsource of the combo. But I can not figure out how this will produce a list any shorter than I was suggesting using a range list. It looks like to me the user would have to type at least 7 numbers to filter the list below a few thousand records. The other thing is I can not imagine that 40k records of nothing but ID takes more than a couple of seconds to load.

 

[ChristinaFC]

The reason I had to do something about my comboboxes is that I e.g. had a form with 3 comboboxes, each including fields concatenated from up to three different tables with each 40'-70' records. As the form was continuous 16 records showed up on the screen a time and the form became very slow, both to load and to work with (each time I advanced a record, the computer needed time to reload/display the form).

My solution in the end was as follows:

I first linked the form to a new query (instead of directly to the underlying table) which calculated the concatenated fields once and for all.

For each combo earlier linked to a query:

I created a textbox linked to the concatenated field from the query.
Properties:
Name: txtCompanyID
Control Source: fldCompany
Tab Stop: No
Back Style: Normal

On top/in front of this I created a combobox:
Properties:
Back Style: Transparent
Control Source: CompanyID
Row Source: [Blank]
Row Source Type: Table/Query
After Update: [Event] (se macro text below)
On Change: [Event] (se macro text below)
Name: cboCompanyID
Tab Stop: Yes

To the form I attached the following code (for the above combobox).

Private Sub cboCompanyID_Change()
Call ReloadcboCompanyID(Nz(Me.cboCompanyID.Text, ""))
End Sub

Sub ReloadcboCompanyID(strTextInCbo As String)'Makes company name and CompanyID load to combobox when three letters are typed into the box
Const conCompanynameMin = 3
If Len(strTextInCbo) > conCompanynameMin Then GoTo LastLine 'This is to avoid a short delay for each time an additional letter is typed, after the first three have been entered
Dim strCompanynameStub As String
Dim strNewStub As String 'First chars of the text in the cbo
strNewStub = Nz(Left(strTextInCbo, conCompanynameMin), "")
'If first n chars are the same as previously, do nothing.
If strNewStub <> strCompanynameStub Then
If Len(strNewStub) < conCompanynameMin Then
'Remove the RowSource
Me.cboCompanyID.RowSource = ""
strCompanynameStub = ""
Else
'New RowSource
Me.cboCompanyID.RowSource = "SELECT fldCompany, CompanyID FROM qryFtgsLista WHERE (fldCompany Like """ & strNewStub & "*"") ORDER BY fldCompany "
strCompanynameStub = strNewStub
Me.cboCompanyID.Dropdown 'Drops down combobox
End If
End If
LastLine:
End Sub


'Removes text from combobox so this is blank. The field behind shows the same text (this works around the bug that the cbo otherwise will show a blank value in continuous forms)
Private Sub cboCompanyID_AfterUpdate()
Me.cboCompanyID.RowSource = vbNullString
End Sub

I then repeated this for all comboboxes.

The result is incredible. I have for a year tried to understand why my database hung all the time (with Not Responding), especially if more than one person at a time was connected to the back end of the database. It turned out that this did the trick – the database is now superfast to use. It takes a bit longer to open up a form (as it now has to run the query), but after that it is not slow at all.

Again, many thanks for your help!