Transpose an ADO recordset

I've got a JET/ADO query in a VB6 app that returns a recordset with x1 to xn columns, y1 to yn rows, and a value (an average) for each cell. I need to transpose - in memory, not excel - this so that I have x1 to xn as rows, y1 to yn as column names and the correct value in each cell.

Anyone have any VB6 code that will do this? Note: the number of columns/rows is dynamic and changes depending on user inputs.

sort of like:

public function TranADOset(rstIn as adodb.recordsset) as adodb.recordset
'do the transpose
end function
thePrisonerAsked:
Who is Participating?
 
stevbeConnect With a Mentor Commented:
so if you want to build the recordset entirely in memory with ADO instead of using a temp table ....

Set rst = .... blah blah ... this part you already have

    'create blank recordset for storing ttransposed items
    Set rstMem = New ADODB.Recordset

    i = 1
    Do While not rst.EOF
        rstMem.Fields.Append "Field" & i, adVarChar, 255
        i = i + 1
        rst.MoveNext
   End If

   'ok ... now you have the recordset structure transposed, fill values
   i = 1
   rstMem.Open
       Do While not rst.EOF
           For Each fld In rst.fields
                rstMem.AddNew
                rstMem.Fields("Field" & i).Value = fld.Value
                rstmem.Update
                i = i + 1
           Next
           rst.MoveNext
       Next

Set Me.grdAvg.Recordset = rstMem
0
 
Steve BinkConnect With a Mentor Commented:
You can do it, but I would not worry about making it a recordset.  ADO recordsets contain the GetRows method, which transforms a recordset into an array.  From there, you have much more flexibility in how you want to display the data, and is overall easier to deal with than a recordset.  The main difficulty you will run into is if you have to update data.  You will have to devise a system by which you can open the recordset, find the record which is to be altered, and commit the changes, based on the data in the array.  Really not that difficult, but it could be a little confusing..

0
 
thePrisonerAuthor Commented:
I need to end up with an ADO recordset since I need to bid that to a grid. good point re getrows: got any code?
0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
stevbeConnect With a Mentor Commented:
got some at work but I am at home now :-(
0
 
thePrisonerAuthor Commented:
Stevbe,

How about Monday?
0
 
stevbeConnect With a Mentor Commented:
sure thing ...
0
 
nmilmineConnect With a Mentor Commented:
This is a function I have used to transpose and create a new table to use

Function TransposeCourses(strSource As String, strTarget As String)

   Dim db As DAO.Database
   Dim tdfNewDef As DAO.TableDef
   Dim fldNewField As DAO.Field
   Dim rstSource As DAO.Recordset, rstTarget As DAO.Recordset
   Dim i As Integer, j As Integer

   On Error GoTo Transposer_Err

   Set db = CurrentDb()
   Set rstSource = db.OpenRecordset(strSource)
   rstSource.MoveLast
   
   'Delete old table
   DoCmd.DeleteObject acTable, "Averages - Course"

   ' Create a new table to hold the transposed data.
   ' Create a field for each record in the original table.
   Set tdfNewDef = db.CreateTableDef(strTarget)
      Set fldNewField = tdfNewDef.CreateField("Category", dbText)
      tdfNewDef.Fields.Append fldNewField
      Set fldNewField = tdfNewDef.CreateField("Average", dbSingle)
      tdfNewDef.Fields.Append fldNewField
   
   db.TableDefs.Append tdfNewDef

   ' Open the new table and fill the first field with
   ' field names from the original table.
   Set rstTarget = db.OpenRecordset(strTarget)
   For i = 0 To rstSource.Fields.Count - 1
      With rstTarget
        .AddNew
        .Fields(0) = rstSource.Fields(i).Name
        .Update
      End With
   Next i

   rstSource.MoveFirst
   rstTarget.MoveFirst
   ' Fill each column of the new table
   ' with a record from the original table.
   For j = 0 To rstSource.Fields.Count - 1
      ' Begin with the second field, because the first field
      ' already contains the field names.
      For i = 1 To rstTarget.Fields.Count - 1
         With rstTarget
            .Edit
            .Fields(i) = rstSource.Fields(j)
            rstSource.MoveNext
            .Update
         End With

      Next i
      rstSource.MoveFirst
      rstTarget.MoveNext
   Next j

   db.Close

   Exit Function

Transposer_Err:

   Select Case Err
      Case 3010
         MsgBox "The table " & strTarget & " already exists."
      Case 3078
         MsgBox "The table " & strSource & " doesn't exist."
      Case Else
         MsgBox CStr(Err) & " " & Err.Description
   End Select

   Exit Function

End Function
'To test the function, press CTRL+G. In the Immediate window, type the following line,
'and then press ENTER:
'Print TransposeCourses("Average Course Results", "Averages - Course")

Cheers
Neil
0
 
Steve BinkConnect With a Mentor Commented:
Here's some code that shows how to use GetRows().  Also, you could consider creating an Excel object (not a visible app...just the object), populating the sheet with the recordset, transpose it using Excel's built-in method, then requery the updated sheet to return another recordset.  GetRows returns an array, not a recordset, but it should be just as easy for you to use.  I'll see if I can test out some code for you.  In the meantime:

Set db = CurrentDB
Set rs = db.OpenRecordset("SELECT * FROM MyTable")

MyArray = rs.GetRows

For y = 0 to ubound(MyArray,1)    ' loops through the records
   For x = 0 to ubound(MyArray,0)   ' loops through fields
      Debug.Print MyArray(x,y)
   Next ' x
Next ' y
0
 
thePrisonerAuthor Commented:
Thanks stevbe, that was enough to get me there. FYI, here's the final code.


Private Function FlipTheGrid(rstIN As ADODB.Recordset, _
                             rstOUT As ADODB.Recordset, FLD0 As String) As Boolean
    'transpose the recordset and return it
    Dim i As Long
    Dim x As Long
    Dim fld As ADODB.field
    'Debug.Print "RSTIN-FLDs: " & rstIN.Fields.Count '7
    'Debug.Print "RSTIN-RECs: " & rstIN.RecordCount '14
    i = 1
    rstOUT.Fields.Append FLD0, adVarChar, 255  'the factor name fld
    Do While Not rstIN.EOF
        rstOUT.Fields.Append rstIN.Fields(0).Value, adVarChar, 255
        i = i + 1
        rstIN.MoveNext
    Loop
    i = 1
    If rstIN.RecordCount > 0 Then
        rstIN.MoveFirst
    End If
    rstOUT.Open
    'Debug.Print "RSTOUT-FLDs: " & rstOUT.Fields.Count '14
    'Debug.Print "RSTOUT-RECs: " & rstOUT.RecordCount  '7
    'pass 1: create a record for each factor, factor name as value for fld 1
    i = 1
    For x = 1 To rstIN.Fields.Count - 1
        rstOUT.AddNew
        rstOUT.Fields(0).Value = rstIN.Fields(x).name
        rstOUT.UpdateBatch adAffectAllChapters
    Next
    'Debug.Print "RSTOUT-FLDs: " & rstOUT.Fields.Count '14
    'Debug.Print "RSTOUT-RECs: " & rstOUT.RecordCount  '7
    rstOUT.MoveFirst
    rstIN.MoveFirst
    'pass 2 for each record in, write down record after record in that fld in OUT.
    For i = 1 To rstOUT.Fields.Count - 1
        rstOUT.MoveFirst
        For x = 1 To rstIN.Fields.Count - 1
            rstOUT.Fields(i).Value = Format(rstIN.Fields(x).Value, "#.00")
            rstOUT.UpdateBatch adAffectAllChapters
            rstOUT.MoveNext
        Next
        rstIN.MoveNext
    Next
    FlipTheGrid = True
End Function
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.