Get related fields

[adam]

I’m trying to make the following code to get the related fields of textbox sales from the table CUSTOMER.

Let’s say for example,
When the user types a value in text box “txtSales” the related values from table CUSTOMER gets copied into the text fields. If the value is not available in the table it pop ups a message requesting the user to add a customer.

But no matter what number I write in textbox sales I’m getting the top row data only.

How can I overcome this?

Code: Select all

Private Sub txtSales_Change()
    
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim strSQL      As String
    Dim bFound      As Boolean
    Dim answer      As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If Me.Sales.Value <> "" Then
    
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ace.OLEDB.12.0; " & _
             "Data Source=D:\DATA\Database.accdb;"
    
    Set rst = New ADODB.Recordset
    
    strSQL = "SELECT [CU No] FROM CUSTOMER WHERE [CU No]='" & Me.Sales.Value & "'"
    rst.Open Source:=strSQL, ActiveConnection:=cnn, Options:=adCmdText
    bFound = Not rst.EOF
    rst.Close
    
    If Not bFound Then
        answer = MsgBox("This Customer is not registered. Do you want to register this Customer?", vbYesNo + vbQuestion, "Excel")
        
        If answer = vbYes Then
            frmAddNew.Show vbModeless
            frmCreateList.Hide
        Else
            Me.Bill.Value = ""
        End If
        Exit Sub
    End If
    
    rst.Open "CUSTOMER", cnn, adOpenKeyset, adLockOptimistic, adCmdTable
    
    
    With rst
        Me.Name.Value = rst![RName]
        Me.ContactNo.Value = rst![Contact No]
    End With
    
    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    End If
End Sub

[HansV]

You open a recordset on

"SELECT [CU No] FROM CUSTOMER WHERE [CU No]='" & Me.Sales.Value & "'"

This returns the record for the value in the text box. But then you close that recordset, and open a recordset on

"CUSTOMER"

i.e. on the whole table. I see no reason to close the original recordset and then open a new one.

[adam]

Based on your query, I have changed the code as follows. Now I keep getting the error Could not set the value property. Type Mismatch If I type a value that is not in the customer table.
What may be the reason for this?

Code: Select all

Private Sub txtSales_Change()
    
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim strSQL      As String
    Dim bFound      As Boolean
    Dim answer      As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If Me.Sales.Value <> "" Then
    
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ace.OLEDB.12.0; " & _
             "Data Source=D:\DATA\Database.accdb;"
    
    Set rst = New ADODB.Recordset
    
    strSQL = "SELECT [RName],[Contact No] FROM CUSTOMER WHERE [CU No]='" & Me.Sales.Value & "'"
    rst.Open Source:=strSQL, ActiveConnection:=cnn, Options:=adCmdText
    bFound = Not rst.EOF
        Me.Name.Value = rst![RName]
        Me.ContactNo.Value = rst![Contact No]

    If Not bFound Then
        answer = MsgBox("This Customer is not registered. Do you want to register this Customer?", vbYesNo + vbQuestion, "Excel")
        
        If answer = vbYes Then
            frmAddNew.Show vbModeless
            frmCreateList.Hide
        Else
            Me.Bill.Value = ""
        End If
        Exit Sub
    End If
    
    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    End If
End Sub

[HansV]

You have to check bFound first, and only set the values AFTER that check, of course. There is no point in setting the values first and then performing the check.

Don't lock the barn after the horse has bolted!

[adam]

Did you mean like this? It does work now.

Code: Select all

Private Sub txtSales_Change()
    
    Dim cnn         As ADODB.Connection
    Dim rst         As ADODB.Recordset
    Dim strSQL      As String
    Dim bFound      As Boolean
    Dim answer      As Integer
    
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    If Me.Sales.Value <> "" Then
    
    Set cnn = New ADODB.Connection
    cnn.Open "Provider=Microsoft.ace.OLEDB.12.0; " & _
             "Data Source=D:\DATA\Database.accdb;"
    
    Set rst = New ADODB.Recordset
    
    strSQL = "SELECT [RName],[Contact No] FROM CUSTOMER WHERE [CU No]='" & Me.Sales.Value & "'"
    rst.Open Source:=strSQL, ActiveConnection:=cnn, Options:=adCmdText
    bFound = Not rst.EOF

    If Not bFound Then
        answer = MsgBox("This Customer is not registered. Do you want to register this Customer?", vbYesNo + vbQuestion, "Excel")
        
        If answer = vbYes Then
            frmAddNew.Show vbModeless
            frmCreateList.Hide
        Else
            Me.Bill.Value = ""
        End If
        Exit Sub
    End If
        Me.Name.Value = rst![RName]
        Me.ContactNo.Value = rst![Contact No]
    rst.Close
    cnn.Close
    
    Set rst = Nothing
    Set cnn = Nothing
    
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
    End If
End Sub

[HansV]

Yes, indeed.

[adam]

Thanks for the help very much.