Results 1 to 4 of 4
  1. #1
    Join Date
    Dec 2002
    Location
    Columbus, GA
    Posts
    81

    Unanswered: Report Help Needed

    Is there any way to make my values go HORIZONTAL instead of VERTICAL?

    Example, I run a report now that pulsl from a query of ACTIVE PRODUCTS.

    The report currently displays information as

    PRODUCT1
    PRODUCT2
    PRODUCT3
    PRODUCT4
    PRODUCT5

    I would like to have it display as

    PRODUCT1, PRODUCT2, PRODUCT3, PRODUCT4

    Keep in mind PRODUCT is the field name and the report is listing each one of them. meaning on my report, I put PRODUCT and when I view the report, it lists each product as mentioned above.

    Anyone have any ideas on how to get my values to display horizontal instead of vertical?

  2. #2
    Join Date
    Feb 2002
    Posts
    403
    The only way I have found is to create a cross tab report on the fly. How are you at SQL?

  3. #3
    Join Date
    Dec 2002
    Location
    Columbus, GA
    Posts
    81
    i know a little, we can try, whats your idea?

  4. #4
    Join Date
    Feb 2002
    Posts
    403
    Have a look through this series of modules

    Private Sub MakeQuery()
    Dim strSQL As String
    Dim strQueryName As String

    strSQL = "TRANSFORM Avg(tblClientResults.TestResult) AS AvgOfTestResult " & _
    "SELECT tblClientResults.Test, tblClientTest.TestType, " & _
    "Avg(tblClientResults.TestResult) AS [Total Of TestResult] " & _
    "FROM tblClientTest RIGHT JOIN (tblPoolTestParameter LEFT JOIN " & _
    "tblClientResults ON tblPoolTestParameter.TestParameterID " & _
    "= tblClientResults.TestParameter) ON tblClientTest.TestID = tblClientResults.Test " & _
    "GROUP BY tblClientResults.Test, tblClientTest.TestType " & _
    "PIVOT tblPoolTestParameter.TestAcronym;"

    strQueryName = "qxtbClientTest"

    Call myCreateQuery(strSQL, strQueryName)

    Call FindFields

    End Sub
    Private Sub FindFields()
    'Now we walk the parameter tables and create an sql statement to
    'return all the fields from the parameters table

    'Then we create a query to bind the form data to
    Dim strSQL As String
    Dim strFirst As String
    Dim strLast As String
    Dim strTrimmed As String
    Dim rst As ADODB.Recordset

    'strFirst returns records from the test table
    strFirst = "Select tblClientTest.TestID, tblClientTest.PoolID, tblClientTest.TestDate, tblClientTest.TestType, "


    Set rst = New ADODB.Recordset

    rst.Open "tblPoolTestParameter", CurrentProject.Connection, adOpenStatic, adLockOptimistic

    With rst

    If .RecordCount > 0 Then

    .MoveFirst

    Do

    'strLast contains the bit that becomes the joining part for the transform query created above

    If strLast = "" Then

    strLast = "qxtbClientTest." & .Fields("TestAcronym") & ","

    Else

    strLast = strLast & "qxtbClientTest." & .Fields("TestAcronym") & ","

    End If

    .MoveNext

    Loop Until .EOF

    End If

    End With

    If Len(strLast) > 0 Then

    'Now we take the value of strlast and trim off the trailing comma

    strTrimmed = Len(strLast)

    strTrimmed = Left(strLast, (strTrimmed - 1))

    Debug.Print strTrimmed

    'Merge the two statements together to form the first half of the SQL definition

    strFirst = strFirst & strTrimmed

    strSQL = strFirst & _
    " FROM tblClientTest LEFT JOIN qxtbClientTest ON tblClientTest.TestID = qxtbClientTest.Test " & _
    "Group by tblClientTest.TestID,tblClientTest.PoolID, tblClientTest.TestDate, tblClientTest.TestType, " & strTrimmed & _
    " HAVING (((tblClientTest.PoolID)=Client())) " & _
    "ORDER BY tblClientTest.TestID DESC;"

    Call myCreateQuery(strSQL, "qryAA2")

    Me.RecordSource = "qryAA2"


    End If

    rst.Close

    Set rst = Nothing


    End Sub

    Private Sub ApplyControlSource()
    Dim rst As ADODB.Recordset
    Dim ctl As Control
    Dim intCount As Integer
    Dim lblName As String

    Set rst = New ADODB.Recordset

    rst.Open "tblPoolTestParameter", CurrentProject.Connection, adOpenStatic, adLockOptimistic

    With rst

    If .RecordCount > 0 Then

    .MoveFirst

    intCount = 0

    For Each ctl In Me.Controls

    If Not .EOF Then

    If ctl.ControlType = acTextBox Then

    If ctl.ControlSource = "" Then

    intCount = intCount + 1

    ctl.ControlSource = .Fields("TestAcronym")

    Call AssignLabelNames(rst.Fields("TestAcronym"), intCount)

    .MoveNext


    End If

    End If

    End If


    Next

    End If

    End With

    rst.Close

    Set rst = Nothing


    End Sub
    Private Sub AssignLabelNames(strName As String, intCount As Integer)
    Dim ctl As Control

    For Each ctl In Me.Controls

    If ctl.ControlType = acLabel Then

    Debug.Print ctl.Name

    If ctl.Name = "lbl" & intCount Then

    ctl.Caption = strName

    End If

    End If

    Next

    End Sub
    Private Sub CleanUpForm()
    Dim ctl As Control

    For Each ctl In Me.Controls

    If ctl.ControlType = acLabel Then

    If Left(ctl.Caption, 3) = "lbl" Then

    ctl.Width = 0

    ctl.Visible = False

    End If

    ElseIf ctl.ControlType = acTextBox Then

    If ctl.ControlSource = "" Then

    ctl.Width = 0

    ctl.Visible = False

    End If

    End If

    Next
    End Sub

    In a seperate module CreateQuery and DestroyQuery
    Sub myCreateQuery(strSQL As String, strQueryName As String)
    'Test JIT Query creation
    'The idea is to create the query for only as long as we need it
    'Then delete it on closing the form

    On Error GoTo MyCreateQuery_ErrHandler:

    Dim Cat As ADOX.Catalog
    Dim cmd As ADODB.Command
    Dim strTrimmed As String
    Set Cat = New ADOX.Catalog

    'Open the catalog
    Cat.ActiveConnection = CurrentProject.Connection

    Set cmd = New ADODB.Command

    strTrimmed = Len(strSQL)

    strTrimmed = Left(strSQL, (strTrimmed - 1))

    Debug.Print strTrimmed

    strTrimmed = strTrimmed & " With OwnerAccess Option;"

    cmd.CommandText = strTrimmed

    Debug.Print strTrimmed

    Cat.Views.Append strQueryName, cmd

    Set Cat = Nothing

    Exit_Here:

    Exit Sub


    MyCreateQuery_ErrHandler:

    If Err.Number = -2147217816 Then

    Resume Next

    Else

    MsgBox "Bas Create Query " & Err.Number & " " & Err.Description


    End If


    End Sub
    Sub DestroyQuery(strQueryName As String)
    'On close we want to destroy the query

    On Error GoTo ErrorHandler_destroyQuery

    Dim Cat As ADOX.Catalog


    Set Cat = New ADOX.Catalog

    Cat.ActiveConnection = CurrentProject.Connection

    Cat.Views.Delete (strQueryName)

    Cat.Procedures.Delete (strQueryName)

    Set Cat = Nothing

    Exit_Here:

    Exit Sub

    ErrorHandler_destroyQuery:


    If Err.Number = 3265 Then

    Resume Next

    End If



    End Sub

    The above code works where I have a known quantity of unknowns. That is in my case I have 8 textboxes on my form and no query can return more than 8. I create a query as a recordsource as this form(in my case) once created is resident for the day.

    I think you could add create controls module to create the controls on the fly giving you true unknown unknowns.

    I hope this will get you started. If not post an extract and we will try and solve it.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •