I'm trying to create a module to transpose a table.
Testing the module using CTRL+G and "?Transposer("Table 1","TableTrans"
in the "Immediate" pane results in an error "3021 No Current Record" and the resulting table has the first field filled, the first row filled, the remainder blank.
I'm no DAO expert, so any assistance will be appreciated.
The code is as follows:
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
Testing the module using CTRL+G and "?Transposer("Table 1","TableTrans"
in the "Immediate" pane results in an error "3021 No Current Record" and the resulting table has the first field filled, the first row filled, the remainder blank.I'm no DAO expert, so any assistance will be appreciated.
The code is as follows:
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
