L
lisa
I found Roger Carlson Denormalized database from the discussion group to
convert Table from Columns to Rows. The db is exactly what i am looking to
do, however the field property Roger had set is integer, and I need the
datatype to be text. I tried changing his code but keeps getting a conversion
error, please help
Below is the code.
Option Compare Database
Option Explicit
'**********************************
'Created by Roger Carlson *
'(e-mail address removed)*
'(e-mail address removed) *
'**********************************
Sub DenormalizeTable2()
'this is the main subroutine which calls the others
CreateDenormalizedTable2 (MaxNumberOfFields2)
Denormalize2
End Sub
Function MaxNumberOfFields2()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim NumberOfFields As Integer
Set db = CurrentDb
strSQL = "SELECT TOP 1 Count(Table3.Value) AS FieldCount " _
& "FROM Table3 " _
& "GROUP BY Table3.ID " _
& "ORDER BY Count(Table3.Value) DESC;"
Set rs = db.OpenRecordset(strSQL)
MaxNumberOfFields2 = rs!FieldCount
End Function
Sub CreateDenormalizedTable2(FieldCount As Integer)
On Error GoTo Err_CreateDenormalizedTable
Dim db As DAO.Database
Dim tblNew As DAO.TableDef
Dim fld As Field
Dim IndexNumber As Integer
Set db = CurrentDb
'delete table
db.TableDefs.Delete "table4"
' Create the table and a field
Set tblNew = db.CreateTableDef("Table4")
Set fld = tblNew.CreateField("ID", dbText)
tblNew.Fields.Append fld
For IndexNumber = 1 To FieldCount
Set fld = tblNew.CreateField("Value" & IndexNumber, dbLong)
' Set field properties here if you want ie.
' fld.Required = True
'
' Append field to Fields collection
tblNew.Fields.Append fld
Next IndexNumber
' Append table to TableDef collection
db.TableDefs.Append tblNew
Exit_CreateDenormalizedTable:
Exit Sub
Err_CreateDenormalizedTable:
If Err.Number = 3265 Then
Resume Next
Else
MsgBox Err.Description
Resume Exit_CreateDenormalizedTable
End If
End Sub
Sub Denormalize2()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim FieldCount As Integer
Dim currentID As String, previousID As String
Set db = CurrentDb
Set rs1 = db.OpenRecordset("Table3") 'table with old format
Set rs2 = db.OpenRecordset("Table4") 'table with new format
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * from Table4")
DoCmd.SetWarnings True
FieldCount = 1
rs1.MoveFirst
Do While Not rs1.EOF
currentID = rs1!ID
If currentID <> previousID Then
FieldCount = 1
rs2.AddNew
rs2!ID = rs1!ID
rs2("Value" & FieldCount) = rs1!Value
rs2.Update
Else
FieldCount = FieldCount + 1
rs2.MoveLast
rs2.Edit
rs2!ID = rs1!ID
--------> rs2("Value" & FieldCount) = rs1!Value (THIS IS WHERE IT'S
ERROR)
rs2.Update
End If
previousID = currentID
rs1.MoveNext
Loop
End Sub
convert Table from Columns to Rows. The db is exactly what i am looking to
do, however the field property Roger had set is integer, and I need the
datatype to be text. I tried changing his code but keeps getting a conversion
error, please help
Below is the code.
Option Compare Database
Option Explicit
'**********************************
'Created by Roger Carlson *
'(e-mail address removed)*
'(e-mail address removed) *
'**********************************
Sub DenormalizeTable2()
'this is the main subroutine which calls the others
CreateDenormalizedTable2 (MaxNumberOfFields2)
Denormalize2
End Sub
Function MaxNumberOfFields2()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Dim NumberOfFields As Integer
Set db = CurrentDb
strSQL = "SELECT TOP 1 Count(Table3.Value) AS FieldCount " _
& "FROM Table3 " _
& "GROUP BY Table3.ID " _
& "ORDER BY Count(Table3.Value) DESC;"
Set rs = db.OpenRecordset(strSQL)
MaxNumberOfFields2 = rs!FieldCount
End Function
Sub CreateDenormalizedTable2(FieldCount As Integer)
On Error GoTo Err_CreateDenormalizedTable
Dim db As DAO.Database
Dim tblNew As DAO.TableDef
Dim fld As Field
Dim IndexNumber As Integer
Set db = CurrentDb
'delete table
db.TableDefs.Delete "table4"
' Create the table and a field
Set tblNew = db.CreateTableDef("Table4")
Set fld = tblNew.CreateField("ID", dbText)
tblNew.Fields.Append fld
For IndexNumber = 1 To FieldCount
Set fld = tblNew.CreateField("Value" & IndexNumber, dbLong)
' Set field properties here if you want ie.
' fld.Required = True
'
' Append field to Fields collection
tblNew.Fields.Append fld
Next IndexNumber
' Append table to TableDef collection
db.TableDefs.Append tblNew
Exit_CreateDenormalizedTable:
Exit Sub
Err_CreateDenormalizedTable:
If Err.Number = 3265 Then
Resume Next
Else
MsgBox Err.Description
Resume Exit_CreateDenormalizedTable
End If
End Sub
Sub Denormalize2()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim FieldCount As Integer
Dim currentID As String, previousID As String
Set db = CurrentDb
Set rs1 = db.OpenRecordset("Table3") 'table with old format
Set rs2 = db.OpenRecordset("Table4") 'table with new format
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * from Table4")
DoCmd.SetWarnings True
FieldCount = 1
rs1.MoveFirst
Do While Not rs1.EOF
currentID = rs1!ID
If currentID <> previousID Then
FieldCount = 1
rs2.AddNew
rs2!ID = rs1!ID
rs2("Value" & FieldCount) = rs1!Value
rs2.Update
Else
FieldCount = FieldCount + 1
rs2.MoveLast
rs2.Edit
rs2!ID = rs1!ID
--------> rs2("Value" & FieldCount) = rs1!Value (THIS IS WHERE IT'S
ERROR)
rs2.Update
End If
previousID = currentID
rs1.MoveNext
Loop
End Sub