flyinghippo99
Registered User.
- Local time
- Today, 07:03
- Joined
- Feb 28, 2011
- Messages
- 53
Hi All,
I've written this Transposer function that takes the name of the source table and transpose(switch rows,columns) into the destination table.
Everything works fine, except when there's space in the data fields.
For example, if the original source table was a 5X6 and was filled with
data then the transposed version is a 6X5 destination table with all the data showing correctly.
However, if just ONE single data field(or cell) is empty then the the resulting 6X5 table will show BUT the data stops at that FIRST empty cell even though the remaining cells have data.
hmm..
Pls kindly look below.
thnx!
flyinghippo99
=========================================
I've written this Transposer function that takes the name of the source table and transpose(switch rows,columns) into the destination table.
Everything works fine, except when there's space in the data fields.
For example, if the original source table was a 5X6 and was filled with
data then the transposed version is a 6X5 destination table with all the data showing correctly.
However, if just ONE single data field(or cell) is empty then the the resulting 6X5 table will show BUT the data stops at that FIRST empty cell even though the remaining cells have data.
hmm..
Pls kindly look below.
thnx!
flyinghippo99
=========================================
Code:
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
If doesExists(db, strTarget) Then
SQLDropTblStmt = "DROP TABLE " & strTarget
CurrentProject.Connection.Execute SQLDropTblStmt
End If
' Create a new table to hold the transposed data.
' Create a field for each record in the original table.
' Adding the columns into tdfNewDef
Set tdfNewDef = db.CreateTableDef(strTarget)
For i = 0 To rstSource.RecordCount + 1
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
MetricsName = rstSource.Fields(i).Name
' because at the zeroth field there's a title "metricsdate"
If i = 0 Then
.Fields(0) = " "
.Fields(1) = " "
.Update
Else
Dim rs As ADODB.Recordset
Dim SQLMasterKeyTblLookup As String
Set rs = New ADODB.Recordset
rs.ActiveConnection = CurrentProject.Connection
SQLMasterKeyTblLookup = "SELECT KeyNum" & _
" FROM Attr " & _
" WHERE (MetricsName=" & Chr(34) & MetricsName & Chr(34) & " );"
rs.Source = SQLMasterKeyTblLookup
rs.CursorType = adOpenDynamic
rs.LockType = adLockOptimistic
rs.Open
KeyNum = rs!KeyNum
.Fields(0) = KeyNum
.Fields(1) = rstSource.Fields(i).Name
.Update
End If
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 = 2 To rstTarget.Fields.Count - 1
With rstTarget
.Edit
'MsgBox rstSource.Fields(j)
.Fields(i) = rstSource.Fields(j)
.Update
rstSource.MoveNext
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 "in the else error case"
' MsgBox CStr(Err) & " " & Err.Description
End Select
Exit Function
End Function
Last edited by a moderator:
