Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Access and Access VBA > Access
| Search | Today's Posts | Mark Forums Read
Access Discussion of Microsoft Access database design and programming. See also the forums for Access ASP and Access VBA.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Access section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #1 (permalink)  
Old September 13th, 2007, 06:12 PM
Registered User
 
Join Date: Sep 2007
Location: , , .
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default Transpose Table - Editing the MS KB code

Hi,

I am trying to transpose a table as below (underlined = field names - not data):

[u]Type of transaction Company1 Company2 Company3 to Company250</u>
Transaction1 10 40 70
Transaction2 20 50 80
Transaction3 30 60 90

to

[u]Company Code Transaction1 Transaction2 Transaction3</u>
Company1 10 20 30
Company2 40 50 60
Company3 70 80 90
to Company250

What the MS knowledgebase example (http://support.microsoft.com/?kbid=283875) currently produces is:

[u]Column1 Column2 Column3 Column4</u>
Type of transaction Transaction1 Transaction2 Transaction3
Company1 10 20 30
Company2 40 50 60
Company3 70 80 90

I suspect it would just be a matter of cycling through the fieldnames, and renaming each one to the contents of the first record, and then deleting the first record. I'm not a VBA guy, and am planning on doing the rest of my project in SQL, but there is no way to transpose a table in SQL that I know of.

The MS Knowledge Base article provides the following code:

Code:
Function Transposer(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

   ' Create a new table to hold the transposed data.
   ' Create a field for each record in the original table.
   Set tdfNewDef = db.CreateTableDef(strTarget)
   For i = 0 To rstSource.RecordCount
      Set fldNewField = tdfNewDef.CreateField(CStr(i + 1), dbText)
      tdfNewDef.Fields.Append fldNewField
   Next i
   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
I am proposing bolting on an additional piece of code as follows (in pseudo code)

For i = 1 To rstTarget.Fields.Count
rstTarget.Fields.Name = runSQL ("SELECT " & i & " from " & rstTarget & " WHERE 1 = 'Type of Transaction'")
Next i

...and need to find out how if the best way to delete the first record (with the new field names) would just be to use SQL "DELETE FROM " & rstTarget & "WHERE [Company Code] = 'Type of Transaction'".

I know the original table sucks, but I have no control over that design, and need to work with it in my project, hence why I am trying to transpose the table.

  #2 (permalink)  
Old September 14th, 2007, 02:11 AM
Registered User
 
Join Date: Sep 2007
Location: Harare, n/a, Zimbabwe.
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Define: Transpose (Just to clarify)
To reverse the orientation of a matrix, so that the values across the rows become the values down the columns, and the values of the columns become the values across the rows
  #3 (permalink)  
Old September 14th, 2007, 02:48 AM
Registered User
 
Join Date: Sep 2007
Location: Harare, n/a, Zimbabwe.
Posts: 2
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Dim CN as New Connection
Dim RSOld as Recordset, RSNew as Recordset
Dim i as Integer, j as Integer

'open a connection to the database
CN.Open <connection string to database>

'get the data from the old table
Set RSOld = CN.Execute("SELECT * FROM <old table name>")

'create a new recordset - this will be used for the transposed data
Set RSNew as New Recordset
RSNew.CursorLocation = adUseClient

'add the first field to the new recordset and set its data type to
'adBSTR (string)
RSNew.Fields.Append "Company Code", adBSTR

'loop thru the old recordset
While Not RSOld.EOF
    'adds the first column val of each row in the old table as a new
    'column in the new recordset - sets the data type of this column
    'to adDouble (double) assuming its value could be big and have
    'decimal places
    RSNew.Fields.Append RSOld.Fields(0).Value, adDouble
    RSOld.MoveNext
Wend

'finalize the new recordset and open it
RSNew.Open

'loop thru the column names in the old table
For i = 1 to RSOld.Fields.Count - 1
    j = 0
    'add a new record (row) to the new recordset
    RSNew.AddNew
    'make the first column value (company code) = the old column name
    RSNew.Fields(0) = RSOld.Fields(i).Name
    'transpose the data for every record (row) in that that old
    'column to the new ROW ONLY
    While Not RSOld.EOF
        j = j + 1
        RSNew.Fields(j) = RSOld.Fields(i)
        RSOld.Movenext
    Wend
    'go to the beginning of the old recordset again
    RSOld.Movefirst
Next i


The above code is in pure visual basic, not VBA so may have to be slightly translated (syntactically only) - !!I HAVE NEVER RUN THIS CODE!!


Similar Threads
Thread Thread Starter Forum Replies Last Post
Transpose Rows/Pivot Table prasanta2expert Access 0 April 26th, 2008 01:01 AM
How do i keep users from editing my table? dstein4d Access VBA 3 April 6th, 2006 08:07 PM
Editing in Pivot Table brrmsc VBScript 0 November 29th, 2005 01:10 AM
What is the code for editing data bisigreat VB How-To 2 August 19th, 2004 03:06 AM
Checking page size in kb G Classic ASP Basics 1 September 24th, 2003 02:47 AM





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.