Solved Populating Combobox with a lot of data. (1 Viewer)

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
I have a combobox that I wish to populate with lots of records. I'm trying to adapt Allen Browns code (demo for populating a combobox with postcodes), but haven't got it right. I have a table called 'TBL_Fittings_Products' with PK:productID(Autonumber) & PM_Part_Number (Short Text). I've copied Allen Browns Code & adapted it. I've left the variable names as per Allen for now. See below.

The combo box is populated correctly with the rowsource with the productIDs starting with the 3 digits entered into [ProductID] on the form. But upon moving to a different field the combobox does not retain the value (displays nothing).

If someone can assist with the code it would be appreciated.

Code:
Option Compare Database
Option Explicit
Const conSuburbMin = 3
Function ReloadSuburb(sSuburb As String)
    Dim sSuburbStub As String
    Dim sNewStub As String    ' First chars of Suburb.Text


    sNewStub = Nz(Left(sSuburb, conSuburbMin), "")
    ' If first n chars are the same as previously, do nothing.
    If sNewStub <> sSuburbStub Then
        If Len(sNewStub) < conSuburbMin Then
            'Remove the RowSource
            Me.ProductID.RowSource = "SELECT ProductID,PM_Part_Number FROM tbl_Fittings_Products WHERE (False);"
            sSuburbStub = ""
        Else
            'New RowSource
            Me.ProductID.RowSource = "SELECT  ProductID,PM_Part_Number FROM tbl_Fittings_Products WHERE (PM_Part_Number Like """ & sNewStub & "*"") ORDER BY ProductID;" ' This works Correctly
            sSuburbStub = sNewStub
        End If
    End If
End Function
Private Sub Form_Current()
    Call ReloadSuburb(Nz(Me.ProductID, ""))
End Sub
Private Sub ProductID_AfterUpdate()
 Dim cbo As ComboBox
    Set cbo = Me.ProductID
    If Not IsNull(cbo.Value) Then
        If cbo.Value = cbo.Column(0) Then
            If Len(cbo.Column(1)) > 0 Then
                'Me.ProductID = cbo.Column(1)
                Me.ProductID = cbo.Column(0)
            End If
            'If Len(cbo.Column(2)) > 0 Then
             '   Me.ProductID = cbo.Column(1)
           ' End If
        Else
            Me.ProductID = Null
        End If
    End If
    Set cbo = Nothing
End Sub
Private Sub ProductID_Change()
Dim cbo As ComboBox         ' Suburb combo.
    Dim sText As String         ' Text property of combo.


    Set cbo = Me.ProductID
    sText = cbo.Text
    Select Case sText
    Case " "                    ' Remove initial space
        cbo = Null
    'Case "MT "                  ' Change "Mt " to "Mount ".
       ' cbo = "MOUNT "
       ' cbo.SelStart = 6
       'Call ReloadSuburb(sText)
    Case Else                   ' Reload RowSource data.
        Call ReloadSuburb(sText)
    End Select
    Set cbo = Nothing
End Sub
 

MarkK

bit cruncher
Local time
Today, 09:13
Joined
Mar 17, 2004
Messages
7,851
Post a sample database. I am interested in this problem, but understanding someone else's code is hard. Also, copying this code locally and trying to make it work is hard. Make it easier, if you want, and post something we can run.
Cheers,
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 11:13
Joined
Feb 28, 2001
Messages
21,193
Frequently, the problem is the bound column and/or columns widths in the combo box. You sometimes have to play with column widths to make it display what you want.
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
Gents, I was hoping that someone may be able to resolve my matter by reviewing the code. It's no small task for me to strip out sensitive data that I'd have to do prior to posting. I've used this code successfully in the past, but it was really just a copy/paste of the Allen Brown code. In his example he did not have an autonumber PK, but a text PK so a bit different. Appreciate any advice.
 

The_Doc_Man

Immoderate Moderator
Staff member
Local time
Today, 11:13
Joined
Feb 28, 2001
Messages
21,193
The combo box is populated correctly with the rowsource with the productIDs starting with the 3 digits entered into [ProductID] on the form. But upon moving to a different field the combobox does not retain the value (displays nothing).

This behavior is due to something done in one of a very limited number of places:

1. Something done in the LostFocus routine of the combo box itself or
2. Something done in the GotFocus routine of whatever follows the combo box in Tab order (or precedes it in Shift-Tab order) or
3. It is a setting (NOT code-related) in the combo box properties.

For one instance, Width and ListWidth are the widths of the control when idle or when in use. If Width is narrow compared to ListWidth, truncation of the combo box may occur in odd ways - particularly if the column you want to display is to the right of the right edge of the Width specification.
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
The_Doc_Man, what I see populated in the Combobox is the ProductID only, although I do have a column count of 2. If that helps. Before I played with this routine, I used a 'normal' lookup with same settings for the combobox but using the query as the row source all worked properly. Cheers.
 

Cronk

Registered User.
Local time
Tomorrow, 04:13
Joined
Jul 4, 2013
Messages
2,560
You are passing the ProductID to the Reload function, not the suburb

Code:
Private Sub Form_Current()
    Call ReloadSuburb(Nz(Me.ProductID, ""))
End Sub
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
Cronk, thanks. Will give it a go & let you know.
 

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 01:13
Joined
May 7, 2009
Messages
14,626
do you have any other code that might put your form to New record
if the combo is altered? might be the cause of "blanking" of fields?
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
Arnelgp, no. This is a new form i'm developing. Tomorrow i'll change my code to reflect Cronks recommendation. I'll let you know. Cheers.
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
People, I've made an excerpt from my database project to show what I intend to do. The combo box does not retain the selected value. I'm sure it's simple, & I'd appreciate some help. Eventually, I see the combo populated with lots of items, thus the need to 'cull' out items that don't start with matching 3 characters. Appreciate the help.
 

Attachments

  • Quotes_Test.accdb
    800 KB · Views: 134

arnelgp

..forever waiting... waiting for jellybean!
Local time
Tomorrow, 01:13
Joined
May 7, 2009
Messages
14,626
check and test again.
see the code of current_event.
 

Attachments

  • Quotes_Test.accdb
    800 KB · Views: 133

MajP

You've got your good things, and you've got mine.
Local time
Today, 12:13
Joined
May 21, 2018
Messages
5,690
Code:
Const CharacterMin = 3
'MUST Be a module level variable as per Allen Browne
Dim sProductStub As String

Function ReloadProduct(sProduct As String)
    Dim sNewStub As String    ' First chars of Suburb.Text
    sNewStub = Nz(Left(sProduct, CharacterMin), "")
    ' If first n chars are the same as previously, do nothing.
    If sNewStub <> sProductStub Then
        If Len(sNewStub) < CharacterMin Then
            'Remove the RowSource
            Me.ProductID.RowSource = "SELECT ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE (False);"
            sProductStub = ""
        Else
            'New RowSource
            Me.ProductID.RowSource = "SELECT  ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE PM_Part_Number Like '" & sNewStub & "*'"
            sProductStub = sNewStub
            Me.ProductID.SetFocus
            If IsNull(Me.ProductID) Then Me.ProductID.Dropdown
        End If
    End If
End Function

Private Sub Form_Current()
    'Allen Browne was displaying and binding the same column. You are not.
    Dim PID As String
    PID = Nz(DLookup("PM_Part_Number", "TBL_Fittings_Products", "ProductID = " & Nz(Me.ProductID, 0)))
    Call ReloadProduct(PID)
End Sub
 
Last edited:

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
Gents, thanking you in advance. Will let you know how i go. Cheers
 

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
Gents, I swapped in MajP's code. Problem is that the 'ProductID' is not saved upon creating a new record. Upon entering the first 3 characters. the list is filtered, but the record is blank upon selection. Attached is another copy in case I've done something wrong. See the last few records in 'tblQuote_Fittings to see records I've generated without the field 'ProductID' being populated. It's probably simple. Cheers.
 

Attachments

  • Quotes_Test.accdb
    816 KB · Views: 115

MajP

You've got your good things, and you've got mine.
Local time
Today, 12:13
Joined
May 21, 2018
Messages
5,690
That is not the code I provided. Since my code works, why did you not use it? Just paste what I provided. Do not change the module level variable into a procedure level variable.

I posted this
Code:
Const CharacterMin = 3
'MUST Be a module level variable as per Allen Browne
Dim sProductStub As String

Function ReloadProduct(sProduct As String)
    Dim sNewStub As String    ' First chars of Suburb.Text
  
    sNewStub = Nz(Left(sProduct, CharacterMin), "")
    ' If first n chars are the same as previously, do nothing.
    If sNewStub <> sProductStub Then
        If Len(sNewStub) < CharacterMin Then
            'Remove the RowSource
            Me.ProductID.RowSource = "SELECT ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE (False);"
            sProductStub = ""
        Else
            'New RowSource
            Me.ProductID.RowSource = "SELECT  ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE PM_Part_Number Like '" & sNewStub & "*'"
            sProductStub = sNewStub
            Me.ProductID.SetFocus
            If IsNull(Me.ProductID) Then Me.ProductID.Dropdown
        End If
    End If
End Function
You posted this
Code:
Const CharacterMin = 3

Function ReloadProduct(sProduct As String)
     Dim sNewStub As String    ' First chars of Suburb.Text
     Dim sProductStub As String
  
   sNewStub = Nz(Left(sProduct, CharacterMin), "")
    ' If first n chars are the same as previously, do nothing.
    If sNewStub <> sProductStub Then
        If Len(sNewStub) < CharacterMin Then
            'Remove the RowSource
            Me.ProductID.RowSource = "SELECT ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE (False);"
            sProductStub = ""
        Else
            'New RowSource
            Me.ProductID.RowSource = "SELECT  ProductID, PM_Part_Number FROM tbl_Fittings_Products WHERE PM_Part_Number Like '" & sNewStub & "*'"
            sProductStub = sNewStub
            Me.ProductID.SetFocus
            If IsNull(Me.ProductID) Then Me.ProductID.Dropdown
        End If
    End If
End Function
 

MajP

You've got your good things, and you've got mine.
Local time
Today, 12:13
Joined
May 21, 2018
Messages
5,690
I guess i should have posted the DB since this code makes no sense to me and that is part of the problem. What is that supposed to do? I cannot makes heads or tails of the thought process. Whatever it is, it is the other part of the problem.

Code:
Private Sub ProductID_AfterUpdate()
' Dim cbo As ComboBox
'   Set cbo = Me.ProductID
'   If Not IsNull(cbo.Value) Then
        'If cbo.Value = cbo.Column(0) Then
        '    If Len(cbo.Column(1)) > 0 Then
        '        Me.ProductID = cbo.Column(1)
                'Me.ProductID = cbo.Column(0)
        '    End If
            'If Len(cbo.Column(2)) > 0 Then
             '   Me.ProductID = cbo.Column(1)
           ' End If
        'Else
        '    Me.ProductID = Null
        'End If
  '  End If
  '  Set cbo = Nothing

End Sub

However, the main reason this nonsensical code fails is here
If cbo.Value = cbo.Column(0) Then
the columns of a combo I think are converted to string so you need to convert them back
If cbo.Value = clng(cbo.Column(0)) Then
And because of the failure of that if check it always went to this line
Me.ProductID = Null

FYI, I modified the on current event again to make it more correct. I differentiate between the PID and the PartNumber.
 

Attachments

  • Quotes_Test (1).accdb
    816 KB · Views: 77
Last edited:

HillTJ

Registered User.
Local time
Today, 06:13
Joined
Apr 1, 2019
Messages
517
MajP, i'm trying. Sorry, this is a new concept for me. Really appreciate your assistance. I'll have a look at the example & let you know how i go. Humble pie for dinner again.
 

Users who are viewing this thread

Top Bottom