Create Report On the Fly

  • Thread starter Thread starter NEWER USER
  • Start date Start date
N

NEWER USER

I have a form with several multi list boxes. Once a row(s) is selected, a
WHERE string is built, deletes an existing Query, and then builds a new
Query1 with that Where string criteria. I then build a Crosstab query with
the Query1 criteria. This works very well and vey fast. Instead of opening
the Crosstab Query (as code shows), I would like to display the retrieved
data in an AutoReport: Tabular design. Because the row values in my lstGroup
box will change (required selection; have yet to code), I will need to
delete/create/replace the existing report with the new values in the Crosstab
Query because the Column Headings in the report must change with row
selectionin lstGroup.

Any ideas on how I might accomplish is gtreatly appreciated. Thanks.

Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click
Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strWhere3 As String
Dim strWhere4 As String
Dim strWhere5 As String
Dim strWhere6 As String
Dim strWhere7 As String
Dim strWhere8 As String
Dim strWhere9 As String
Dim lngLen As Long
Dim strDelim As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strDoc As String

'Build WHERE string
With Me!lstGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere1 = "[GroupID] IN (" & Left$(strWhere1, lngLen) & ") "
End If

With Me!lstClass
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere2 = strWhere2 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere2) - 1
If lngLen > 0 Then
strWhere2 = "[CO] IN (" & Left$(strWhere2, lngLen) & ") "
End If

With Me!lstBrand
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere3 = strWhere3 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere3) - 1
If lngLen > 0 Then
strWhere3 = "[SupplierID] IN (" & Left$(strWhere3, lngLen) & ") "
End If

With Me!lstJGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere4 = strWhere4 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere4) - 1
If lngLen > 0 Then
strWhere4 = "[JobGroup] IN (" & Left$(strWhere4, lngLen) & ") "
End If

With Me!lstMake
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere5 = strWhere5 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere5) - 1
If lngLen > 0 Then
strWhere5 = "[Make] IN (" & Left$(strWhere5, lngLen) & ") "
End If

With Me!lstModel
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere6 = strWhere6 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere6) - 1
If lngLen > 0 Then
strWhere6 = "[Model] IN (" & Left$(strWhere6, lngLen) & ") "
End If

With Me!lstEngine
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere7 = strWhere7 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere7) - 1
If lngLen > 0 Then
strWhere7 = "[Engine] IN (" & Left$(strWhere7, lngLen) & ") "
End If

With Me!lstType
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere8 = strWhere8 & strDelim & .ItemData(varItem) & strDelim & ","
End If
Next varItem
End With

lngLen = Len(strWhere8) - 1
If lngLen > 0 Then
strWhere8 = "[TypeID] IN (" & Left$(strWhere8, lngLen) & ") "
End If

With Me!lstEGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere9 = strWhere9 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere9) - 1
If lngLen > 0 Then
strWhere9 = "[Description] IN (" & Left$(strWhere9, lngLen) & ") "
End If

strWhere = strWhere1

If Len(strWhere) > 0 And Len(strWhere2) > 0 Then
strWhere = strWhere & " AND " & strWhere2
Else
strWhere = strWhere & strWhere2
End If

If Len(strWhere) > 0 And Len(strWhere3) > 0 Then
strWhere = strWhere & " AND " & strWhere3
Else
strWhere = strWhere & strWhere3
End If

If Len(strWhere) > 0 And Len(strWhere4) > 0 Then
strWhere = strWhere & " AND " & strWhere4
Else
strWhere = strWhere & strWhere4
End If

If Len(strWhere) > 0 And Len(strWhere5) > 0 Then
strWhere = strWhere & " AND " & strWhere5
Else
strWhere = strWhere & strWhere5
End If

If Len(strWhere) > 0 And Len(strWhere6) > 0 Then
strWhere = strWhere & " AND " & strWhere6
Else
strWhere = strWhere & strWhere6
End If

If Len(strWhere) > 0 And Len(strWhere7) > 0 Then
strWhere = strWhere & " AND " & strWhere7
Else
strWhere = strWhere & strWhere7
End If

If Len(strWhere) > 0 And Len(strWhere8) > 0 Then
strWhere = strWhere & " AND " & strWhere8
Else
strWhere = strWhere & strWhere8
End If

If Len(strWhere) > 0 And Len(strWhere9) > 0 Then
strWhere = strWhere & " AND " & strWhere9
Else
strWhere = strWhere & strWhere9
End If

Set db = CurrentDb

'*** create the query based on the information on the form
strSQL = "SELECT qryxCatalog.* FROM qryxCatalog "
strSQL = strSQL & " WHERE " & strWhere
'*** delete the previous query
db.QueryDefs.Delete "qryxCatalog1"
Set qdf = db.CreateQueryDef("qryxCatalog1", strSQL)
'*** open the query

strDoc = "qryxCatalogCrosstab"

DoCmd.SetWarnings False
DoCmd.OpenQuery strDoc, acNormal, acEdit
DoCmd.Close acForm, "frmSelectCriteriaCrosstab"
DoCmd.SetWarnings True

Exit_cmdOK_Click:
Exit Sub

Err_cmdOK_Click:
If Err.Number = 3265 Then
Resume Next
Else
MsgBox Err.Description
Resume Exit_cmdOK_Click
End If

End Sub
 
Here's some code that I used in a report I wrote 10 years ago, that may
help. As I remember, I created more columns than I would need, and filled
them as needed in code:

Option Compare Database 'Use database order for string comparisons.
Option Explicit

' Constant for maximum number of columns XTab query would
' create plus 1 for a Totals column.
Const conTotalColumns = 11

' Variables for Database object and Recordset.
Dim dbsReport As Database
Dim rstReport As Recordset

' Variables for number of columns and row and report totals.
Dim intColumnCount As Integer
Dim lngRgColumnTotal(1 To conTotalColumns) As Long
Dim lngReportTotal As Long

Private Sub Detail1_Format(Cancel As Integer, FormatCount As Integer)
' Place values in text boxes and hide unused text boxes.

Dim intX As Integer
' Verify that not at end of recordset.
If Not rstReport.EOF Then
' If FormatCount is 1, place values from recordset into text boxes
' in detail section.
If Me.FormatCount = 1 Then
For intX = 1 To intColumnCount
' Convert Null values to 0.
Me("Col" + Format(intX)) = xtabCnulls(rstReport(intX - 1))
Next intX

' Hide unused text boxes in detail section.
For intX = intColumnCount + 2 To conTotalColumns
Me("Col" + Format(intX)).Visible = False
Next intX

' Move to next record in recordset.
rstReport.MoveNext
End If
End If


End Sub
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.mvps.org/access
http://www.accessmvp.com
NEWER USER said:
I have a form with several multi list boxes. Once a row(s) is selected, a
WHERE string is built, deletes an existing Query, and then builds a new
Query1 with that Where string criteria. I then build a Crosstab query with
the Query1 criteria. This works very well and vey fast. Instead of
opening
the Crosstab Query (as code shows), I would like to display the retrieved
data in an AutoReport: Tabular design. Because the row values in my
lstGroup
box will change (required selection; have yet to code), I will need to
delete/create/replace the existing report with the new values in the
Crosstab
Query because the Column Headings in the report must change with row
selectionin lstGroup.

Any ideas on how I might accomplish is gtreatly appreciated. Thanks.

Private Sub cmdOK_Click()
On Error GoTo Err_cmdOK_Click
Dim varItem As Variant
Dim strWhere As String
Dim strWhere1 As String
Dim strWhere2 As String
Dim strWhere3 As String
Dim strWhere4 As String
Dim strWhere5 As String
Dim strWhere6 As String
Dim strWhere7 As String
Dim strWhere8 As String
Dim strWhere9 As String
Dim lngLen As Long
Dim strDelim As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strSQL As String
Dim strDoc As String

'Build WHERE string
With Me!lstGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere1 = strWhere1 & strDelim & .ItemData(varItem) & strDelim &
","
End If
Next varItem
End With

lngLen = Len(strWhere1) - 1
If lngLen > 0 Then
strWhere1 = "[GroupID] IN (" & Left$(strWhere1, lngLen) & ") "
End If

With Me!lstClass
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere2 = strWhere2 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere2) - 1
If lngLen > 0 Then
strWhere2 = "[CO] IN (" & Left$(strWhere2, lngLen) & ") "
End If

With Me!lstBrand
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere3 = strWhere3 & strDelim & .ItemData(varItem) & strDelim &
","
End If
Next varItem
End With

lngLen = Len(strWhere3) - 1
If lngLen > 0 Then
strWhere3 = "[SupplierID] IN (" & Left$(strWhere3, lngLen) & ") "
End If

With Me!lstJGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere4 = strWhere4 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere4) - 1
If lngLen > 0 Then
strWhere4 = "[JobGroup] IN (" & Left$(strWhere4, lngLen) & ") "
End If

With Me!lstMake
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere5 = strWhere5 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere5) - 1
If lngLen > 0 Then
strWhere5 = "[Make] IN (" & Left$(strWhere5, lngLen) & ") "
End If

With Me!lstModel
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere6 = strWhere6 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere6) - 1
If lngLen > 0 Then
strWhere6 = "[Model] IN (" & Left$(strWhere6, lngLen) & ") "
End If

With Me!lstEngine
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere7 = strWhere7 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere7) - 1
If lngLen > 0 Then
strWhere7 = "[Engine] IN (" & Left$(strWhere7, lngLen) & ") "
End If

With Me!lstType
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere8 = strWhere8 & strDelim & .ItemData(varItem) & strDelim &
","
End If
Next varItem
End With

lngLen = Len(strWhere8) - 1
If lngLen > 0 Then
strWhere8 = "[TypeID] IN (" & Left$(strWhere8, lngLen) & ") "
End If

With Me!lstEGroup
For Each varItem In .ItemsSelected
If Not IsNull(varItem) Then
strWhere9 = strWhere9 & "'" & strDelim & .ItemData(varItem) &
strDelim & "',"
End If
Next varItem
End With

lngLen = Len(strWhere9) - 1
If lngLen > 0 Then
strWhere9 = "[Description] IN (" & Left$(strWhere9, lngLen) & ") "
End If

strWhere = strWhere1

If Len(strWhere) > 0 And Len(strWhere2) > 0 Then
strWhere = strWhere & " AND " & strWhere2
Else
strWhere = strWhere & strWhere2
End If

If Len(strWhere) > 0 And Len(strWhere3) > 0 Then
strWhere = strWhere & " AND " & strWhere3
Else
strWhere = strWhere & strWhere3
End If

If Len(strWhere) > 0 And Len(strWhere4) > 0 Then
strWhere = strWhere & " AND " & strWhere4
Else
strWhere = strWhere & strWhere4
End If

If Len(strWhere) > 0 And Len(strWhere5) > 0 Then
strWhere = strWhere & " AND " & strWhere5
Else
strWhere = strWhere & strWhere5
End If

If Len(strWhere) > 0 And Len(strWhere6) > 0 Then
strWhere = strWhere & " AND " & strWhere6
Else
strWhere = strWhere & strWhere6
End If

If Len(strWhere) > 0 And Len(strWhere7) > 0 Then
strWhere = strWhere & " AND " & strWhere7
Else
strWhere = strWhere & strWhere7
End If

If Len(strWhere) > 0 And Len(strWhere8) > 0 Then
strWhere = strWhere & " AND " & strWhere8
Else
strWhere = strWhere & strWhere8
End If

If Len(strWhere) > 0 And Len(strWhere9) > 0 Then
strWhere = strWhere & " AND " & strWhere9
Else
strWhere = strWhere & strWhere9
End If

Set db = CurrentDb

'*** create the query based on the information on the form
strSQL = "SELECT qryxCatalog.* FROM qryxCatalog "
strSQL = strSQL & " WHERE " & strWhere
'*** delete the previous query
db.QueryDefs.Delete "qryxCatalog1"
Set qdf = db.CreateQueryDef("qryxCatalog1", strSQL)
'*** open the query

strDoc = "qryxCatalogCrosstab"

DoCmd.SetWarnings False
DoCmd.OpenQuery strDoc, acNormal, acEdit
DoCmd.Close acForm, "frmSelectCriteriaCrosstab"
DoCmd.SetWarnings True

Exit_cmdOK_Click:
Exit Sub

Err_cmdOK_Click:
If Err.Number = 3265 Then
Resume Next
Else
MsgBox Err.Description
Resume Exit_cmdOK_Click
End If

End Sub
Click to expand...
 
Back
Top