MS Access vba transpose columns into rows or rows into columns

in one of tables similar statistics were storen in columns per empoloyee per week.

EMPL WEEK T_N1 T_N2 T_N3 etc
aaa 200712 5 0 0

I need a tnrasnformed form like this

EMPL WEEK STAT N
aaa 200712 T_N1 5

By using this transformed form it becomes possible to extend facts with additional information per statistics by making a join on STAT field.

So here is the VBA code to make the tranformation.


Attribute VB_Name = "mdlTranspose"
Option Compare Database

Function TransColRow(strSource As String, strTarget As String, nF As Integer)
' transpose columns into rows
' first nF rows are not ransposed
' names of the transposed column are saved into the FIELD in the target table
' Numerical values of the transposed columns saved into target field N
' if the transposed fields are not numeric change dbInteger into the right datatype

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, k 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 non transposable fields from the original table.
Set tdfNewDef = db.CreateTableDef(strTarget)

For i = 0 To nF - 1
Set fldNewField = tdfNewDef.CreateField(rstSource.Fields(i).Name, rstSource.Fields(i).Type)
tdfNewDef.Fields.Append fldNewField
Next i
Set fldNewField = tdfNewDef.CreateField("FIELD", dbText)
tdfNewDef.Fields.Append fldNewField

Set fldNewField = tdfNewDef.CreateField("N", dbInteger)
tdfNewDef.Fields.Append fldNewField

db.TableDefs.Append tdfNewDef
Set rstTarget = db.OpenRecordset(strTarget)

rstSource.MoveFirst
Do While Not rstSource.EOF
For j = nF To rstSource.Fields.Count - 1
With rstTarget
If rstSource.Fields(j) > 0 Then
.AddNew
For k = 0 To nF - 1
.Fields(k) = rstSource.Fields(k)
Next k
.Fields(nF) = rstSource.Fields(j).Name
.Fields(nF + 1) = rstSource.Fields(j)
.Update
End If
End With
Next j

rstSource.MoveNext
Loop
rstSource.Close
rstTarget.Close
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







' reverse transofmation (rows into columns )


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 = 3 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