Apparently, I did not clue in that the table/query data underlying these controls is such that for any given record, it is possible to have a value for one field/control but not for its child control, thus there is still a record being returned, but the child field is Null (my bad ). So you have to test for Null in the recordset field. Unless you are storing empty strings ("") it should not be necessary to test for those as well. Based on the sql I see for your combos, you are only retruning 1 field, so the recordset field to test is 0 (rs.Fields is zero based). This has been added to the first code block I posted, as well as a block to ensure the color is something other than yellow if a subsequent update on a parent control results in null values for the child. A requery of the child control was also added to clear it out in that case. I added a line marked missing. That one raises a red flag for me in that you should have gotten a run time error.
Once the parent selection is made, the child should become yellow if it has no list values. If you want its color to be something else after a value has been chosen, you'll need an after update event on it to set that color. Otherwise it will stay yellow throughout the rest of the form edit (assuming user does not go back and alter the parent). Something like
If Me.cmbChild <> "" Then Me.cmbChild.BackColor = vbWhite
My solution was tested and works, but obviously I cannot include your code and test as a whole procedure.
Code:
Private Sub cboRev_AfterUpdate()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSql As String
With Me
.txtComponent = Nz(DLookup("Primary", "DRAWINGS", "Drawing='" & Me.cboComponent & "' AND Revision ='" & Me.cboRev & "'"), "")
.txtDescription = DLookup("Description", "PDatabase", "[PartNumber] = '" & Me.txtComponent & "'")
.txtUOM = DLookup("PurchaseUOM", "PDatabase", "[PartNumber] = '" & Me.txtComponent & "'")
.txtCageCode = DLookup("CageCodeA", "Drawings", "[Drawing] = '" & Me.cboComponent & "'")
.txtCageCodeA = DLookup("CageCodeB", "Drawings", "[Drawing] = '" & Me.cboComponent & "'")
.txtCageCodeB = DLookup("CageCodeC", "Drawings", "[Drawing] = '" & Me.cboComponent & "'")
.txtCageCodeC = DLookup("CageCodeD", "Drawings", "[Drawing] = '" & Me.cboComponent & "'")
End With
'Load AlternateA into the drop down
On Error Resume Next
strSql = "SELECT DRAWINGS.AlternateA FROM DRAWINGS WHERE DRAWINGS.Primary = '"
strSql = strSql & Me.txtComponent & "' ORDER BY DRAWINGS.AlternateA;"
txtAlternateA.RowSource = strSql
'Load AlternateB into the drop down
txtAlternateB.RowSource = "Select DRAWINGS.AlternateB FROM DRAWINGS WHERE " &_
"DRAWINGS.Primary = '" & Me.txtComponent & "' AND DRAWINGS.AlternateB Is Not Null " & _
"ORDER BY DRAWINGS.AlternateB;"
'Load AlternateC into the drop down
txtAlternateC.RowSource = "Select DRAWINGS.AlternateC FROM DRAWINGS WHERE " & _
"DRAWINGS.Primary = '" & Me.txtComponent & "' ORDER BY DRAWINGS.AlternateC;"
Set db=CurrentDb 'THIS WAS MISSING - (NOT THE ISSUE)
Set rs = db.OpenRecordset(strSql)
If Not IsNull(rs.Fields(0)) Then
Me.cmbSystem.BackColor = vbYellow
Else
Me.cmbSystem.BackColor = vbWhite
End If
With Me
.cmbSystem.Requery
.cmbSystem = ""
End With
'close recordset and reclaim memory before exiting procedure
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub