Create a Report Using Combo Boxes

[kingofthekassel]

Hi all,



I have a form (shown below) that has four combo boxes and a search button which brings up all the records matching whatever selection I have in those comboboxes. It works perfectly. Now, I need to create reports of those records. I can't seem to figure out how. I have attached a picture of my current form and my code as well. I already have a report that has the exact format that I want but it has ALL of the records. Is there any way that I can sort that report using a button and those comboboxes? Or can I create a specific report unique to the search results with the same format every time? Thank you for all your help and feedback.

~Brett


P.S. The create report button that I have there now opens the report called "AllRisksReport". I hoped that this code would sort it, but it doesn't and it still gives all risks.


CODE:


Option Compare Database
Option Explicit
Private Sub cmdFilter_Click()
Dim strWhere As String
Dim lngLen As Long
Const conJetDate = "\#mm\/dd\/yyyy\#"

If Not IsNull(Me.Combo13) Then
strWhere = strWhere & "([RiskNo] = """ & Me.Combo13 & """) AND "
End If

If Not IsNull(Me.Combo17) Then
strWhere = strWhere & "([Subcategory] = """ & Me.Combo17 & """) AND "
End If

If Not IsNull(Me.Combo19) Then
strWhere = strWhere & "([IPT] = """ & Me.Combo19 & """) AND "
End If

If Not IsNull(Me.Combo23) Then
strWhere = strWhere & "([Level] = """ & Me.Combo23 & """) AND "
End If

lngLen = Len(strWhere) - 5
If lngLen <= 0 Then
MsgBox "No Criteria", vbInformation, "Nothing To Do."
Else
strWhere = Left$(strWhere, lngLen)

Me.Filter = strWhere
Me.FilterOn = True
End If
End Sub
Private Sub cmdReset_Click()
Dim ctl As Control
For Each ctl In Me.Section(acHeader).Controls
Select Case ctl.ControlType
Case acComboBox
ctl.Value = Null
End Select
Next
Me.Filter = False
Me.FilterOn = True
End Sub

Private Sub Form_Open(Cancel As Integer)
Me.Filter = False
Me.FilterOn = True
End Sub
Private Sub cmdOpen_Form_Click()
Dim stDocName As String
Dim stLinkCriteria As String
Dim lngLen As Long

stDocName = "RisksForm"

If Not IsNull(Me.Combo13) Then
stLinkCriteria = stLinkCriteria & "([RiskNo] = """ & Me.Combo13 & """) AND "
End If

If Not IsNull(Me.Combo17) Then
stLinkCriteria = stLinkCriteria & "([Subcategory] = """ & Me.Combo17 & """) AND "
End If

If Not IsNull(Me.Combo19) Then
stLinkCriteria = stLinkCriteria & "([IPT] = """ & Me.Combo19 & """) AND "
End If

If Not IsNull(Me.Combo23) Then
stLinkCriteria = stLinkCriteria & "([Level] = """ & Me.Combo23 & """) AND "
End If

lngLen = Len(stLinkCriteria) - 5
If lngLen <= 0 Then
MsgBox "No Criteria", vbInformation, "Nothing To Do."
Else
stLinkCriteria = Left$(stLinkCriteria, lngLen)

DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_cmdOpen_Form_Click:
Exit Sub
Err_cmdOpen_Form_Click:
MsgBox Err.Description
Resume Exit_cmdOpen_Form_Click

End If
End Sub

Private Sub cmdCreate_Report_Click()

Dim stDocName As String
Dim stLinkCriteria As String
Dim lngLen As Long
stDocName = "AllRisksReport"

If Not IsNull(Me.Combo13) Then
stLinkCriteria = stLinkCriteria & "([RiskNo] = """ & Me.Combo13 & """) AND "
End If

If Not IsNull(Me.Combo17) Then
stLinkCriteria = stLinkCriteria & "([Subcategory] = """ & Me.Combo17 & """) AND "
End If

If Not IsNull(Me.Combo19) Then
stLinkCriteria = stLinkCriteria & "([IPT] = """ & Me.Combo19 & """) AND "
End If

If Not IsNull(Me.Combo23) Then
stLinkCriteria = stLinkCriteria & "([Level] = """ & Me.Combo23 & """) AND "
End If

lngLen = Len(stLinkCriteria) - 5
If lngLen <= 0 Then
MsgBox "No Criteria", vbInformation, "Nothing To Do."
Else
stLinkCriteria = Left$(stLinkCriteria, lngLen)
DoCmd.OpenReport stDocName, acViewReport
Exit_cmdCreate_Report_Click:
Exit Sub
Err_cmdCreate_Report_Click:
MsgBox Err.Description
Resume Exit_cmdCreate_Report_Click

End If
End Sub

[ranman256]

make the filter a function and you can apply it to forms or reports etc...

Function getFilter()
Dim strWhere As String
Dim lLen As Long


    If Not IsNull(Me.Combo13) Then strWhere = strWhere & "([RiskNo] = """ & Me.Combo13 & """) AND "
    If Not IsNull(Me.Combo17) Then strWhere = strWhere & "([Subcategory] = """ & Me.Combo17 & """) AND "
    If Not IsNull(Me.Combo19) Then strWhere = strWhere & "([IPT] = """ & Me.Combo19 & """) AND "
    If Not IsNull(Me.Combo23) Then strWhere = strWhere & "([Level] = """ & Me.Combo23 & """) AND "
    
    lLen = Len(strWhere) - 5
    If lLen <= 0 Then
        MsgBox "No Criteria", vbInformation, "Nothing To Do."
    Else
        getFilter = Left(strWhere, lLen)
    End If
End Function



   ''for the form
sWhere = getFilter()
if swhere <> "" then 
   Me.Filter = sWhere
   Me.FilterOn = True
endif


    ''for the report
sWhere = getFilter()
DoCmd.OpenReport "rptMyRpt", acViewNormal, , sWhere

[kingofthekassel]

Thanks ranman! So do I replace my entire form and report button code with just those lines? or what should I replace with that?

[ssanfu]

I modified your code a little. You had a couple of "End If"s in the wrong place and "FilterOn"s with the wrong value
This is what ranman256 suggested. The value of have the a function create the filter string is that there is only one place to change the filter creation instead of 3 places.

Try this on a COPY of your dB
This code goes behind the "Risk Search" form (code and pic you posted)

Option Compare Database
Option Explicit

Private Sub cmdFilter_Click()
    Dim strWhere As String
'    Dim lngLen As Long
'    Const conJetDate = "\#mm\/dd\/yyyy\#"

    strWhere = getFilter()
   
    If Len(strWhere) < 1 Then
        msgbox "No Criteria", vbInformation, "Nothing To Do."
    Else

        Me.filter = strWhere
        Me.FilterOn = True
    End If
    
End Sub

Private Sub cmdReset_Click()
    Dim ctl As Control
    
    For Each ctl In Me.Section(acHeader).Controls
        Select Case ctl.ControlType
            Case acComboBox
                ctl.Value = Null
        End Select
    Next
    Me.filter = False
    Me.FilterOn = False

End Sub

Private Sub Form_Open(Cancel As Integer)
    Me.filter = False
    Me.FilterOn = False
End Sub

Private Sub cmdOpen_Form_Click()
    On Error GoTo Err_cmdOpen_Form_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    '    Dim lngLen As Long

    stDocName = "RisksForm"

    stLinkCriteria = getFilter()

    If Len(stLinkCriteria) < 1 Then
        msgbox "No Criteria", vbInformation, "Nothing To Do."
    Else
        DoCmd.OpenForm stDocName, , , stLinkCriteria
    End If


Exit_cmdOpen_Form_Click:
    Exit Sub
Err_cmdOpen_Form_Click:
    msgbox Err.Description
    Resume Exit_cmdOpen_Form_Click

End Sub

Private Sub cmdCreate_Report_Click()
On Error GoTo Err_cmdCreate_Report_Click

    Dim stDocName As String
    Dim stLinkCriteria As String
    '    Dim lngLen As Long

    stDocName = "AllRisksReport"

    stLinkCriteria = getFilter()

    If Len(stLinkCriteria) < 1 Then
        msgbox "No Criteria", vbInformation, "Nothing To Do."
    Else
        DoCmd.OpenReport stDocName, acViewReport, , stLinkCriteria
    End If


Exit_cmdCreate_Report_Click:
    Exit Sub
Err_cmdCreate_Report_Click:
    msgbox Err.Description
    Resume Exit_cmdCreate_Report_Click

End Sub


Function getFilter() As String
    Dim strWhere As String
    Dim lLen As Long


    If Not IsNull(Me.Combo13) Then
        stLinkCriteria = stLinkCriteria & "([RiskNo] = """ & Me.Combo13 & """) AND "
    End If

    If Not IsNull(Me.Combo17) Then
        stLinkCriteria = stLinkCriteria & "([Subcategory] = """ & Me.Combo17 & """) AND "
    End If

    If Not IsNull(Me.Combo19) Then
        stLinkCriteria = stLinkCriteria & "([IPT] = """ & Me.Combo19 & """) AND "
    End If

    If Not IsNull(Me.Combo23) Then
        stLinkCriteria = stLinkCriteria & "([Level] = """ & Me.Combo23 & """) AND "
    End If

    lngLen = Len(stLinkCriteria) - 5
    If lLen <= 0 Then
        getFilter = ""
    Else
        getFilter = Left(strWhere, lLen)
    End If

End Function

Warning: I was not able to test this code.


BTW, control with names like "Combo13", "Combo17", etc should really be given more descriptive names.

I might rename:
"Combo13" to "cboRiskNo"
"Combo17" to "cboSubcategory"

Much, much easier to follow, debug, etc.