-
Need to flatten data
Hello,
I have a table that contains contact names, their titles, and
company_IDs that are used as the Primary Key. There are multiple
contact names and titles per each company_ID. I need to have them all
listed on one row per company_id. Right now it looks like this:
Company_ID Person Title
12345 Bob Smith VP
12345 Pam Rollins President
I need it to be like this:
Company_ID Person01 Title01 Person02 Title02
12345 Bob Smith VP Pam Rollins President
I got it to work using only the contact name (Person) by doing a
make-table query and using Pers: "Person" &
Format(GroupIncrement([company_id]),"00"). GroupIncrement being the
following routine:
Option Compare Database
Option Explicit
Dim lngCompany_ID As Long
Dim lngGroupIncrement As Long
Public Function GroupIncrement(Company_ID As Long) As Long
If Company_ID = lngCompany_ID Then
lngGroupIncrement = lngGroupIncrement + 1
Else
lngGroupIncrement = 1
lngCompany_ID = Company_ID
End If
GroupIncrement = lngGroupIncrement
End Function
This gives me the Person01, 02, 03, etc. part that I want, but I can't
seem to figure out how to add the Title01 to it. Any ideas? I would
appreciate any advice.
-
did you ever find a solution for this? I know its been a long time but i have a similar problem.
-
Hi Wally,
Here's what I ended up with, and it works.
Option Compare Database
Option Explicit
'**********************************
'Created by Roger Carlson *
'Roger.Carlson@spectrum-health.org*
'Rog3erc@aol.com *
'**********************************
Function DenormalizeTable()
'this is the main subroutine which calls the others
CreateDenormalizedTable (MaxNumberOfFields)
Denormalize
End Function
Function MaxNumberOfFields()
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(PERSON.COMPANY_ID) AS FieldCount " _
& "FROM PERSON " _
& "GROUP BY PERSON.Company_ID " _
& "ORDER BY Count(PERSON.COMPANY_ID) DESC;"
Set rs = db.OpenRecordset(strSQL)
MaxNumberOfFields = rs!FieldCount
End Function
Sub CreateDenormalizedTable(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
' Create the table and a field
Set tblNew = db.CreateTableDef("PERSONNEL")
Set fld = tblNew.CreateField("COMPANY_ID", dbDouble)
tblNew.Fields.Append fld
For IndexNumber = 1 To FieldCount
Set fld = tblNew.CreateField("PERSON" & Format(IndexNumber, "00"), dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("TITLE" & Format(IndexNumber, "00"), dbText)
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 Denormalize()
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim FieldCount As Integer
Dim currentCompany_ID As Double, previousCompany_ID As Double
Set db = CurrentDb
Set rs1 = db.OpenRecordset("PERSON") 'table with old format
Set rs2 = db.OpenRecordset("PERSONNEL") 'table with new format
DoCmd.SetWarnings False
DoCmd.RunSQL ("Delete * from PERSONNEL")
DoCmd.SetWarnings True
FieldCount = 1
rs1.MoveFirst
Do While Not rs1.EOF
currentCompany_ID = rs1!Company_ID
If currentCompany_ID <> previousCompany_ID Then
FieldCount = 1
rs2.AddNew
rs2!Company_ID = rs1!Company_ID
rs2("PERSON" & Format(FieldCount, "00")) = rs1!FULNM
rs2("TITLE" & Format(FieldCount, "00")) = rs1!TITLE
rs2.Update
Else
FieldCount = FieldCount + 1
rs2.MoveLast
rs2.Edit
rs2!Company_ID = rs1!Company_ID
rs2("PERSON" & Format(FieldCount, "00")) = rs1!FULNM
rs2("TITLE" & Format(FieldCount, "00")) = rs1!TITLE
rs2.Update
End If
previousCompany_ID = currentCompany_ID
rs1.MoveNext
Loop
End Sub
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
|