ACC: How to Transpose Data in a Table or QueryID: Q182822
|
Novice: Requires knowledge of the user interface on single-user computers.
At times, you may need to transpose the data in a table or query so that
the field names are listed vertically down the left column and the data
extends across the page horizontally. For example, you may need to
transpose the data for a report or before exporting it to a text file. This
article shows you two methods that you can use to accomplish this task.
Method 1 shows you how you can export the data to Microsoft Excel,
transpose the data, and then import the result back into Microsoft Access.
Method 2 shows you how you can use an Access Basic or Visual Basic for
Applications procedure to accomplish this task.
Note that neither method works if you have more than 255 records because the maximum number of fields in a Microsoft Access table is 255.
Function Transposer(strSource As String, strTarget As String)
Dim db As Database
Dim tdfNewDef As TableDef
Dim fldNewField As Field
Dim rstSource As Recordset, rstTarget As 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 - 1
Set fldNewField = tdfNewDef.CreateField(CStr(i + 1), DB_TEXT)
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
rstTarget.AddNew
rstTarget.Fields(0) = rstSource.Fields(i).Name
rstTarget.Update
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
rstTarget.Edit
rstTarget.Fields(i) = rstSource.Fields(j)
rstSource.MoveNext
rstTarget.Update
Next i
rstSource.MoveFirst
rstTarget.MoveNext
Next j
rstSource.Close
rstTarget.Close
db.Close
Exit Function
Transposer_Err:
Select Case Err
Case 3010
MsgBox "The table " & strTarget & " already exists."
Case 3011
MsgBox "The table " & strSource & " doesn't exist."
Case Else
MsgBox CStr(Error) & " " & Error(Err)
End Select
Exit Function
End Function
Function Transposer(strSource As String, strTarget As String)
Dim db As Database
Dim tdfNewDef As TableDef
Dim fldNewField As Field
Dim rstSource As Recordset, rstTarget As 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
Additional query words: inf reverse turn around set up differently
Keywords : IntpOff
Version : WINDOWS:2.0,7.0,97
Platform : WINDOWS
Issue type : kbhowto
Last Reviewed: April 19, 1999