Re: Pivot Records

All thanks goes to Amy Vargo (as opposed to "Vargas")

<bigbore50@xxxxxxxxx> wrote:
Thank you very much

I think this will work


Gary Walter wrote:
Of course your source table/query can not
have more than 255 records. You may want to
adjust code to test source recordcount and at
least return first 255 if recordcount was more
(plus message that did not transpose all data)...

"Gary Walter" wrote
I just tested and following worked for your sample data....

Copy following code into new module.
Save module as (say) "modTranspose"
In top menu, click on Debug/Compile to make
sure no problems with wordwrap, etc.

'***start new code****
Option Explicit

Public Function TableExists(strTableName As String) As Boolean
'from Joe Fallon
On Error Resume Next
TableExists = IsObject(CurrentDb.TableDefs(strTableName))
End Function

'following function adapted from code by Amy Vargas:
'2. To test the function, open the Debug window (or the Immediate
window
' in Microsoft Access version 2.0). If you are in the sample database
' Northwind.mdb (or Nwind.mdb), for example, and you want to
transpose
' the Suppliers table, type the following line, and then press ENTER:
'
' "?Transposer("Suppliers","SuppliersTrans")"
'
'(without the quotation marks)
'
'Regards,
'
'Amy Vargo
'Microsoft Access Engineer

Function Transposer(strSource As String, strTarget As String) As
Boolean

Dim db As DAO.Database
Dim tdfNewDef As DAO.TableDef
Dim fldNewField As DAO.Field
Dim rstSource As DAO.Recordset
Dim rstTarget As DAO.Recordset
Dim i As Long, j As Long

On Error GoTo Transposer_Err

Set db = CurrentDb()
Set rstSource = db.OpenRecordset(strSource)
rstSource.MoveLast

'delete target table if it exists
If TableExists(strTarget) = True Then
db.Execute "DROP TABLE " & strTarget, dbFailOnError
Else
'did not exist
End If

' 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

rstSource.Close
rstTarget.Close
db.Close
Transposer = True
MsgBox "Successfully transposed " & strSource & " to " & strTarget

Exit_Transposer:
If Not rstSource Is Nothing Then Set rstSource = Nothing
If Not rstTarget Is Nothing Then Set rstTarget = Nothing
If Not db Is Nothing Then Set db = Nothing

Exit Function

Transposer_Err:
Transposer = False
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

Resume Exit_Transposer

End Function
'***end new code***





.

Relevant Pages

  • Re: Pivot Records
    ... least return first 255 if recordcount was more ... ' Northwind.mdb, for example, and you want to transpose ... Dim tdfNewDef As DAO.TableDef ... Dim rstTarget As DAO.Recordset ...
    (microsoft.public.access.queries)
  • Re: Pivot Records
    ... least return first 255 if recordcount was more ... ' Northwind.mdb, for example, and you want to transpose ... Dim tdfNewDef As DAO.TableDef ... Dim rstTarget As DAO.Recordset ...
    (microsoft.public.access.queries)
  • Re: No recordcount from a procedure
    ... If you are checking the recordcount property in ADO, ... Dim cn As New ADODB.Connection ... Dim royalty As Variant ... adParamReturnValue) ...
    (microsoft.public.sqlserver.programming)
  • RE: Reading an external text file
    ... Changing the startRow and startColumn values won't make any difference. ... Dim startRow As Integer ... Dim recordCount As Integer ... populate an excel sheet for anaylsis. ...
    (microsoft.public.excel.programming)