Why does selecting item on combo with callback function cause next callback to fail?

[George Allen]

So, I have two comboboxes on my form. One has a vlaue list (A), then other uses a callback function to populate (B) items based on the combo A selection. If I select something in A, then the function correctly populates B. I can do this over and over. However, if I select an item in B, then go back to A to select a different filter, the callback function does not populate B. One thing I noticed was that the combobox.value is still set to the selected value, but clearing that does not help. Ideas?

 
COMBOBOX A AFTER UPDATE
Private Sub cmb_Svc_Section_AfterUpdate()
 
    Redraw_Form
 
    Application.Echo False
 
    With Me![cmb_Provider]
        .RowSourceType = "Fill_Assigned_Provider_List"
        .RowSource = ""
    End With
 
    Application.Echo True
 
 
End Sub
 
COMBOBOX B CALLBACK FUNCTION
 
Function Fill_Assigned_Provider_List(fld As Control, ID As Variant, row As Variant, col As Variant, code As Variant) As Variant
    Static Provider_Assigned_List() As Variant
    Static ProvCount As Integer
 
 
    Const twips = 1440
 
    Select Case code
 
        Case acLBInitialize                ' Initialize.
            DW_Connect
 
 
            StrSQL = "Select * from dim.Provider where InactivationDate is null and ServiceSection is not null;"
'            rs_Provider.CursorLocation = adUseServer
            rs_Provider.Open StrSQL, DWConn, adOpenKeyset, adLockOptimistic, adCmdText
 
            rs_Provider.MoveLast
            rs_Provider.MoveFirst
 
            ReDim Preserve Provider_Assigned_List(rs_Provider.RecordCount, 1) As Variant
 
            Fill_Assigned_Provider_List = True
 
 
            ProvCount = 0
 
            For chkitm = 0 To rs_Provider.RecordCount - 1
                If (Not IsNull(Me.cmb_Svc_Section) And rs_Provider.Fields("ServiceSection") = Me.cmb_Svc_Section) Or (IsNull(Me.cmb_Svc_Section)) Then
                    Provider_Assigned_List(ProvCount, 0) = rs_Provider.Fields("ProviderSID")
                    Provider_Assigned_List(ProvCount, 1) = rs_Provider.Fields("StaffName")
                    ProvCount = ProvCount + 1
                End If
                rs_Provider.MoveNext
            Next chkitm
 
 
        Case acLBOpen                        ' Open.
            Fill_Assigned_Provider_List = Timer
 
        Case acLBGetFormat
            Fill_Assigned_Provider_List = -1
 
        Case acLBGetRowCount            ' Get number of rows.
            Fill_Assigned_Provider_List = ProvCount
 
        Case acLBGetColumnCount    ' Get number of columns.
            Fill_Assigned_Provider_List = 2
 
        Case acLBGetColumnWidth    ' Column width.
            Select Case col
                Case 0:
                    Fill_Assigned_Provider_List = 0
                Case 1:
                    Fill_Assigned_Provider_List = 3 * twips
            End Select
 
 
        Case acLBGetValue                    ' Get data.
 
            Fill_Assigned_Provider_List = Provider_Assigned_List(row, col)
 
        Case acLBEnd
            DWConn.Close
            rs_Provider.Close
            Erase Provider_Assigned_List
 
    End Select
End Function
 
 

[ADezii]

Try NOT Erasing the contents of the Array in Line #86, and see what happens, namely:

'Erase Provider_Assigned_List         Comment Line #86

This is how Access, requests, and receives its Data for the specific Row/Column combination as in Line #81:

Case acLBGetValue                    ' Get data. 
  Fill_Assigned_Provider_List = Provider_Assigned_List(row, col)

[George Allen]

OK, I will give this a shot. I do realize that the acLBGetValue is where the data is being placed in the control, but the code never goes there when it should be.

[George Allen]

Nope, no better. Removing ERASE line does not affect the content of the combobox. It still ends up blank.

I followed code in the callback function. Once I select a item in box B, then select the Box A (even before I make a selection) the callback function is called by the control for the following codes in sequence (By breakpoint check on line 28):
6, 7, 6, 7, 6, 7

After this I make a selection and the callback gets thse codes in sequence:
8,9

Then the thread passes ot the box A Afterupdate subroutine. It walks through the steps until the box A requery, where it jumps back into the callback function with the code 0 then jumos out of the routine and back to the form.

So, it never attempts to refill the box B from my selection in box A once I have made a selection in box B.

[ADezii]

Is there any Code in the AfterUpdate() Event of Combo B, and if so, what is it?

[George Allen]

Yes there is. The code connects to another SQL table and then changes the size and layout of th eform to accomodate data from that other table.

 Private Sub cmb_Provider_AfterUpdate()
    Redraw_Form
    DW_Connect
 
    rs_ScoreData.CursorLocation = adUseServer
 
    strSQLScore = "Select oppesid, measure_ClassSID,measure_Class, Measure, Benchmark, Max(ScoreDate) as Last_Date, sum(Numerator) as Num, sum(Denominator) as Denom from dbo.vw_Score_Result where ProviderSID = " & Me.cmb_Provider.Column(0) & " and ActiveDate <= '" & Me.txt_End_Date & "' and (inactivedate is null or (inactivedate > '" & Me.txt_Start_Date & "' and inactivedate < '" & Me.txt_End_Date & "')) group by oppesid, measure_ClassSID,measure_Class, Measure, Benchmark order by measure_ClassSID, Measure;"
    rs_ScoreData.Open strSQLScore, DWConn, adOpenKeyset, adLockOptimistic, adCmdText
 
 
    Set TmpTblScore_Data = CurrentDb.OpenRecordset("Score", dbOpenDynaset, dbSeeChanges)
    Do While Not TmpTblScore_Data.EOF
        TmpTblScore_Data.Delete
        TmpTblScore_Data.MoveNext
    Loop
 
    Do While Not rs_ScoreData.EOF
        TmpTblScore_Data.AddNew
        TmpTblScore_Data.Fields("OPPESID") = rs_ScoreData.Fields("OPPESID")
        TmpTblScore_Data.Fields("Measure_ClassSID") = rs_ScoreData.Fields("Measure_ClassSID")
        TmpTblScore_Data.Fields("Measure_Class") = rs_ScoreData.Fields("Measure_Class")
        TmpTblScore_Data.Fields("Measure") = rs_ScoreData.Fields("Measure")
        TmpTblScore_Data.Fields("Benchmark") = rs_ScoreData.Fields("Benchmark")
        TmpTblScore_Data.Fields("Last_Date") = rs_ScoreData.Fields("Last_Date")
        TmpTblScore_Data.Fields("Num") = rs_ScoreData.Fields("Num")
        TmpTblScore_Data.Fields("Denom") = rs_ScoreData.Fields("Denom")
        TmpTblScore_Data.Update
        rs_ScoreData.MoveNext
    Loop
 
 
    TopPos = 0
 
    If TmpTblScore_Data.RecordCount > 0 Then
        Set rs_Score_Class = CurrentDb.OpenRecordset("SELECT Measure_ClassSID, Count(OPPESID) AS Num_Rec FROM Score GROUP BY Measure_ClassSID;", dbOpenDynaset, dbSeeChanges)
        rs_Score_Class.MoveFirst
        Do While Not rs_Score_Class.EOF
            Select Case rs_Score_Class.Fields("Measure_ClassSID")
                Case 1
                    Me.subfrm_First.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_First.Visible = True
                    Me.subfrm_First.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 2
                    Me.subfrm_Second.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Second.Visible = True
                    Me.subfrm_Second.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 3
 
                    Me.subfrm_Third.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Third.Visible = True
                    Me.subfrm_Third.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 4
 
                    Me.subfrm_Fourth.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Fourth.Visible = True
                    Me.subfrm_Fourth.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 5
 
                    Me.subfrm_Fifth.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Fifth.Visible = True
                    Me.subfrm_Fifth.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 6
 
                    Me.subfrm_Sixth.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Sixth.Visible = True
                    Me.subfrm_Sixth.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 7
 
                    Me.subfrm_Seventh.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Seventh.Visible = True
                    Me.subfrm_Seventh.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                Case 8
 
                    Me.subfrm_Eight.Move Left:=0, Top:=TopPos, Height:=(0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips
                    Me.subfrm_Eight.Visible = True
                    Me.subfrm_Eight.Requery
                    TopPos = TopPos + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
                    Me.InsideHeight = Me.InsideHeight + ((0.65 + (rs_Score_Class.Fields("Num_Rec") * 0.425)) * twips)
            End Select
            rs_Score_Class.MoveNext
        Loop
 
    End If
 
    TmpTblScore_Data.Close
 
    rs_ScoreData.Close
 
 
    If Me.subfrm_First.Visible = True Then Me.subfrm_First.SetFocus
 
    DWConn.Close
 
 
 
    End Sub
 
 

[George Allen]

Figured it out. I was closing my ADO connection eveytime I used it so I could try and release resources I was not using. Everytime I closed the connection through a DWConn.Close, I was wiping out my provider list. My thought was that each time I called the connection for an ADO call it was a seperate connection. Guessed wrong.

Thanks for your help. Your insistence on looking at Box B afterupdate pointed me in the right direction.

[ADezii]

Actually, I was just looking at this Thread and thinking quite the opposite. To me it was apparent that the problem resided somewhere in the AfterUpdate() Event of B and was thinking along the lines of reopening an existing Connection which may be causing the problem, but was obviously wrong. In any event, nice job on figuring it out.

P.S. - Now that you have resolved the problem, you may wish to consider replacing

With Me![cmb_Provider] 
  .RowSourceType = "Fill_Assigned_Provider_List" 
  .RowSource = "" 
End With 

with

Me![cmb_Provider].Requery

in the AfterUpdate() Event of cmb_Svc-Section. Not sure, but it may be more efficient than redefining the Callback to populate cmb_Provider.

[George Allen]

Thanks again. I will look at making the change. It was an earlier suggestion of yours to try and make another part of this work.