Need to flatten data

[lfarina]

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.

[wally_gtr]

did you ever find a solution for this? I know its been a long time but i have a similar problem.

[lfarina]

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