Link to home
Start Free TrialLog in
Avatar of Karen Schaefer
Karen SchaeferFlag for United States of America

asked on

Determine subform name using controls to pass name

I have a Mainform containing 5 subforms - and I need to set the recordsouce for each subform on selection of a drop down field.  I need to look at each control (ctl) determine the name of the ctl(subform) and if equals a particular name then set the query name accordingly.

see the code that starts with :
" If sfrm.Name = "frmAssignSchoolPrg_sub" Then
                  nQry = "QrySchoolPrograms""

I am currently not getting the sfrm value - what am I missing?

K
Private Sub cboSearch_AfterUpdate()
    Dim rs As Object
    Dim nRecID As String
    Dim strSQL As String
    Dim nQry As String
    Dim curDB As DAO.Database
    Dim frm As Access.Form
    Dim sfrm As Access.SubForm
    Dim ctl As Access.Control
   
    On Error GoTo cboSearch_AfterUpdate_Error
    
    Set curDB = CurrentDb()

    
    nRecID = Me.cboSearch
    Set frm = Forms![frmPrograms]
        For Each ctl In frm.Controls
            If ctl.ControlType = acSubform Then
                If sfrm.Name = "frmAssignSchoolPrg_sub" Then
                  nQry = "QrySchoolPrograms"
                  GoSub Process
                ElseIf sfrm.Name = "frmlPrgContacts_sub" Then
                  nQry = "qryPrgContacts"
                  GoSub Process
                ElseIf sfrm.Name = "frmPrgCert_sub" Then
                  nQry = "qryPrgCertificates"
                  GoSub Process
                ElseIf sfrm.Name = "frmGrants_Assign_sub" Then
                  nQry = "qryGrantAssignments"
                  GoSub Process
                ElseIf sfrm.Name = "frmAttachments_sub" Then
                  nQry = "qryPhotoAttachments"
                  GoSub Process
                End If
Process:
                If nRecID = 0 Then
                    strSQL = "Select * from " & nQry & ""
                Else
                    strSQL = strSQL & " WHERE ProgramRecID = " & nRecID & ""
                End If
                
                strSQL = "SELECT * FROM  " & nQry & ""
                ctl.frm.sfrm.RecordSource = strSQL
Return:
            End If
       Next ctl
       Set ctl = Nothing
    '            Set qdfTemp = CurrentDb.CreateQueryDef("qryTemp", strSQL)
    '            Set qdf = curDB.QueryDefs("TempQry")
    '            qdf.SQL = strSQL
    '            qdf.Close
                    
                  ' End If
   
    On Error GoTo 0
   Exit Sub

cboSearch_AfterUpdate_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cboSearch_AfterUpdate of VBA Document Form_frmPrograms"

End Sub

Open in new window

Avatar of IrogSinta
IrogSinta
Flag of United States of America image

Try
 If ctl.Name = "frmAssignSchoolPrg_sub" Then
Avatar of Karen Schaefer

ASKER

ok, thanks that fixed the initial problem but now I am getting an error on
            ctl.frm.sfrm.RecordSource = strSQL

Doesn't like "ctl.frm.sfrm.RecordSource"  I tried changing to ctl. without success.

K
Try
ctl.form.Recordsource= strSQL
Ok now my code wants to duplicate the last else if then error Object not found.
ErrorMsg.png
Now i am unable to reselect the dropdown once I ran the code.

Form seems to be locked.

k
It may be stopped at one of your breakpoints.
Try ALT R then E to end your process.
No, the break points where removed and I am still having the issue.  here is my latest attempt - adding a refresh and exit sub within the code.

Private Sub cboSearch_AfterUpdate()
    Dim rs As Object
    Dim nRecID As String
    Dim strSQL As String
    Dim nQry As String
    Dim curDB As DAO.Database
    Dim frm As Access.Form
    Dim sfrm As Access.SubForm
    Dim ctl As Access.Control
   
    On Error GoTo cboSearch_AfterUpdate_Error
    
    Set curDB = CurrentDb()

    
    nRecID = Me.cboSearch
    Set frm = Forms![frmPrograms]
        For Each ctl In frm.Controls
            If ctl.ControlType = acSubform Then
                If ctl.Name = "frmAssignSchoolPrg_sub" Then
                  nQry = "QrySchoolPrograms"
                  GoSub Process
                ElseIf ctl.Name = "frmlPrgContacts_sub" Then
                  nQry = "qryPrgContacts"
                  GoSub Process
                ElseIf ctl.Name = "frmPrgCert_sub" Then
                  nQry = "qryPrgCertificates"
                  GoSub Process
                ElseIf ctl.Name = "frmGrants_Assign_sub" Then
                  nQry = "qryGrantAssignments"
                  GoSub Process
                ElseIf ctl.Name = "frmAttachments_sub" Then
                  nQry = "qryPhotoAttachments"
                  GoSub Process
                  Exit Sub
                End If
Process:
                If nRecID = 0 Then
                    strSQL = "Select * from " & nQry & ""
                Else
                    strSQL = strSQL & " WHERE ProgramRecID = " & nRecID & ""
                End If
                
                strSQL = "SELECT * FROM  " & nQry & ""
                ctl.Form.RecordSource = strSQL
            End If
       Next ctl
       Set ctl = Nothing
       Refresh
Return:
    On Error GoTo 0
   Exit Sub

cboSearch_AfterUpdate_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cboSearch_AfterUpdate of VBA Document Form_frmPrograms"

End Sub

Open in new window


k
You may have to step through your running code and see where the problem occurs.
I did that when I added the exit sub and the refresh - but still having issues with the form - unable to reselect the dropdown after code runs.
Just want to point out that this portion of your code doesn't make sense since you are setting strSQL again after you've set it in your If statement.

                If nRecID = 0 Then
                    strSQL = "Select * from " & nQry & ""
                Else
                    strSQL = strSQL & " WHERE ProgramRecID = " & nRecID & ""
                End If
               
                strSQL = "SELECT * FROM  " & nQry & ""

So when you step through your code does your process get to Exit Sub?  Is the combo box the only control that you cannot select or are all the controls on your form locked?
" Is the combo box the only control that you cannot select or are all the controls on your form locked? "

Yes it affects all the forms -

k
So when you step through your code using F8, does your process get to Exit Sub at all?
yes and I found that 1 of my queries was missing the PK for ProgramRecID.

However,  the combo still won't let me reselect it after the form has been updated.

I even put back the recordsource on my main form, originally it was unbound. but did not make a difference.

any ideas.

k
Is the rowsource of your combobox based on one of your subforms?  Other than seeing your database, I may not be of much more help.  Maybe you could post a skeleton sample of it.  One that includes only the necessary forms, queries, and tables to see this problem.
Here is a copy of the mdb.  Open the frmPrograms

Step1.  Select any item from Search by drop down.
Step 2  Click on different tabs, verify the data changed.
Step 3  Re-click on Search by and see how it is disabled.

Any assistance you can offer on rectifying the combo selection issue, is greatly appreciated.

K
sample-db.zip
Some strange things going on with your form.  If I put your comboBox in the Details section it works fine.  I also tried copying all your controls to a new form and the comboBox works fine in the header section.  Try doing that and see if that takes care of the problem.
could you please take a look at the form named Form1 and the code behind it.

The problems seems to be with the setting of the master/child linking of the ProgramRecId for each of the subforms.  However I still need to handle the ALL situation.

Maybe there is a better approach I need to be able to set the record results to limit it to a ProgramRecID when appropriate and show all records when the user Selects "All".  I am going to change approaches and remove the All from the combo and add an All Button to the form.  and put back the Master/Child links on each subform.  if the user selects the All button then I will reset the recordsource to have each subform display all records.

However, I am still looking for a better solution.

Thanks for your input and time.

K
How would you recommend me changing the recordsource for each of the subforms to display all records when I currently using Master/Child links to retrieve data based on the drop down selection and the underlying form is bound.

k
I'm not exactly sure what you mean by Form1 since I don't see that from the original database that you attached unless you meant to attach another one.  However, that sounds like you need to put in another question for other experts to answer since I believe your original question here was already addressed.

I do have a suggestion for your After Update event on your combo box.  Why not just modify your queries to include the search criteria.  For example your qryPhotoAttachments would be:

SELECT * FROM tblAttachments
WHERE ProgramRecID Like Iif(Forms!frmPrograms!cboSearch=0,"*",Forms!frmPrograms!cboSearch)

Then all you would need to do for your After Update event is requery each of the subforms.
IrogSinta,

Thanks for all your input, I tried your latest suggestion with the Where statement, however, the drop down still isn't allowing the user to make a selection after updating the many subforms.

I am still very stumped.  Looking for any other ideas, hence I am putting in a request for further attention.

Here is my latest attempt - as you can see I am trying both ways with the hard code of the control name and also with using the variable, both are currently returning a

Type Mismatch error.

Private Sub cboSearch_AfterUpdate()
    Dim rs As Object
    Dim nRecID As String
    Dim strSQL As String
    Dim strSql1 As String
    Dim strSql2 As String
    Dim strSql3 As String
    Dim strSql4 As String
    
   On Error GoTo cboSearch_AfterUpdate_Error
    Me.TabProgram.Visible = True
    nRecID = Me.cboSearch
    strSQL = "SELECT tblAssignPrgSchool.ProgramRecID, tblPrograms.[Program Title]," & _
                " tblPrograms.[Program Type], tblPrograms.[Program Engagement]," & _
                " tblPrograms.[Program Meetings], tblPrograms.[Program Updates]," & _
                " tblPrograms.[IP Agreement], tblPrograms.[IP Expiration Date]," & _
                " tblPrograms.ROI, tblPrograms.Linked_CTC_CTE, tblPrograms.ERT," & _
                " tblPrograms.Program_Ranking, tblAssignPrgSchool.SchoolNameRecID," & _
                " tblAssignPrgSchool.DateModified" & _
            " FROM tblPrograms INNER JOIN tblAssignPrgSchool ON" & _
                " tblPrograms.ProgramRecID = tblAssignPrgSchool.ProgramRecID"
    
    If nRecID = 0 Then 'frmAssignSchoolPrg_sub
        strSQL = strSQL
    Else
       ' strSQL = strSQL & " WHERE tblPrograms.ProgramRecID = " & nRecID & ""
        strSQL = strSQL & " WHERE tblPrograms.ProgramRecID Like IIf(Forms!frmPrograms!cboSearch = 0, " * ", Forms!frmPrograms!cboSearch)"
        strSQL = strSQL & " WHERE ProgramRecID Like IIf(" & Chr(34) & nRecID & Chr(34) & " = 0, " * ", " & nRecID & ")"
    End If
    
    strSql1 = "SELECT *" & _
            " FROM tblPrgContacts"

    If nRecID = 0 Then  'frmlPrgContacts_sub
        strSql1 = strSql1
    Else
       ' strSql1 = strSql1 & " WHERE ProgramRecID Like IIf(Forms!frmPrograms!cboSearch = 0, " * ", Forms!frmPrograms!cboSearch)"
        strSql1 = strSql1 & " WHERE ProgramRecID Like IIf(" & nRecID & " = 0, " * ", " & nRecID & ")"

    End If
  
    strSql2 = "SELECT *" & _
            " FROM tblProgramCertificates"

    If nRecID = 0 Then  'frmPrgCert_sub
        strSql2 = strSql2
    Else
        'strSql2 = strSql2 & " WHERE tblProgramCertificates.ProgramRecID = " & nRecID & ""
        strSql2 = strSql2 & " WHERE ProgramRecID Like IIf(" & nRecID & " = 0, " * ", " & nRecID & ")"

    End If
    
    strSql3 = "SELECT tblGrants_Assign.GrantRecID, tblGrants_Assign.SchoolNameRecID," & _
                " tblGrants_Assign.GrantAmount, tblGrantInfo.GrantStartDate, tblGrantInfo.GrantEndDate," & _
                " tblGrants_Assign.LeadSchool, tblGrants_Assign.ProgramRecID, tblGrants_Assign.DateModified," & _
                " tblGrants_Assign.GrantComments, tblGrants_Assign.DateModified" & _
            " FROM tblGrantInfo INNER JOIN tblGrants_Assign ON" & _
                " tblGrantInfo.GrantRecID = tblGrants_Assign.GrantRecID"
    
    If nRecID = 0 Then  'frmAttachments_sub
        strSql3 = strSql3
    Else
     '   strSql3 = strSql3 & " WHERE tblGrants_Assign.ProgramRecID = " & nRecID & ""
        strSql3 = strSql3 & " WHERE ProgramRecID Like IIf(" & nRecID & " = 0, " * ", " & nRecID & ")"

    End If
    
    strSql4 = "SELECT *" & _
            " FROM tblAttachments"
    
    If nRecID = 0 Then
        strSql4 = strSql4
    Else
        'strSql4 = strSql4 & " WHERE tblAttachments.ProgramRecID = " & nRecID & ""
        strSql4 = strSql4 & " WHERE ProgramRecID Like IIf(" & nRecID & " = 0, " * ", " & nRecID & ")"

    End If

    Forms![frmPrograms]![frmAssignSchoolPrg_sub].Form.RecordSource = strSQL
    Forms![frmPrograms]![frmlPrgContacts_sub].Form.RecordSource = strSql1
    Forms![frmPrograms]![frmPrgCert_sub].Form.RecordSource = strSql2
    Forms![frmPrograms]![frmGrants_Assign_sub].Form.RecordSource = strSql3
    Forms![frmPrograms]![frmAttachments_sub].Form.RecordSource = strSql4
    Refresh
   On Error GoTo 0
   Exit Sub

cboSearch_AfterUpdate_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cboSearch_AfterUpdate of VBA Document Form_frmPrograms"

End Sub

Open in new window

however, the drop down still isn't allowing the user to make a selection after updating the many subforms.
Perhaps you missed my previous response about this. It works if you copy everything to a new form and just delete the old form.  It also works if you move the drop down to the detail section instead of the header.  There is some corruption in your form.
ok, thanks for the suggestion, I am still having type mismatch  issues with the revised Where statement.  Got any suggestions.


         strSQL = "SELECT tblAssignPrgSchool.ProgramRecID, tblPrograms.[Program Title]," & _
                    " tblPrograms.[Program Type], tblPrograms.[Program Engagement]," & _
                    " tblPrograms.[Program Meetings], tblPrograms.[Program Updates]," & _
                    " tblPrograms.[IP Agreement], tblPrograms.[IP Expiration Date]," & _
                    " tblPrograms.ROI, tblPrograms.Linked_CTC_CTE, tblPrograms.ERT," & _
                    " tblPrograms.Program_Ranking, tblAssignPrgSchool.SchoolNameRecID," & _
                    " tblAssignPrgSchool.DateModified" & _
                " FROM tblPrograms INNER JOIN tblAssignPrgSchool ON" & _
                   " tblPrograms.ProgramRecID = tblAssignPrgSchool.ProgramRecID"

         strWHERE = " WHERE ProgramRecID Like IIf(Forms!frmPrograms!cboSearch = 0, " * ", Forms!frmPrograms!cboSearch)"
Well my suggestion was to put
WHERE ProgramRecID Like Iif(Forms!frmPrograms!cboSearch=0,"*",Forms!frmPrograms!cboSearch) in each of your queries and then you would just do the following for your update event

Private Sub cboSearch_AfterUpdate()
     Me.frmAssignSchoolPrg_sub.Form.Requery
     Me.frmlPrgContacts_sub.Form.Requery
     Me.frmPrgCert_sub.Form.Requery
     Me.frmGrants_Assign_sub.Form.Rquery
     Me.frmAttachments_sub.Form.Requery
End Sub

If you want to keep going with code above instead then use this:
strWHERE = " WHERE ProgramRecID Like "  & IIf(Me.cboSearch = 0, "*", Me.cboSearch) & "'"
When I use your current WHERE statement in the actual query it gives me the TYPE MISMATCH ERROR.

WHERE ProgramRecID Like Iif(Forms!frmPrograms!cboSearch=0,"*",Forms!frmPrograms!cboSearch)

         strSQL = "SELECT tblAssignPrgSchool.ProgramRecID, tblPrograms.[Program Title]," & _
                    " tblPrograms.[Program Type], tblPrograms.[Program Engagement]," & _
                    " tblPrograms.[Program Meetings], tblPrograms.[Program Updates]," & _
                    " tblPrograms.[IP Agreement], tblPrograms.[IP Expiration Date]," & _
                    " tblPrograms.ROI, tblPrograms.Linked_CTC_CTE, tblPrograms.ERT," & _
                    " tblPrograms.Program_Ranking, tblAssignPrgSchool.SchoolNameRecID," & _
                    " tblAssignPrgSchool.DateModified" & _
                " FROM tblPrograms INNER JOIN tblAssignPrgSchool ON" & _
                   " tblPrograms.ProgramRecID = tblAssignPrgSchool.ProgramRecID" & _
                " WHERE ProgramRecID Like IIf(Forms!frmPrograms!cboSearch = 0, " * ", Forms!frmPrograms!cboSearch)"
I'm away from the computer right now.  I'll get back with you in a couple of hours.
OK thanks, I will be call it quits for day in a few myself.

K
ASKER CERTIFIED SOLUTION
Avatar of IrogSinta
IrogSinta
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks for your great assistance, it is always the dumb things that get you in the end.  I am new to 2007 and some of the new features.  that did the trick.

Thanks,

Karen