asked on

transpose multiple records into one

Hi Experts,

I have a data table that looks like this:

MINumber      PL      Calc      Percent
Prod1      B      $16.69      5
Prod1       K      $14.06      20
Prod1      L      $13.35      24
Prod1       P      $12.30      30

Prod2       B      $18.69      5
Prod2       K      $16.06      20
Prod2       L      $19.35      28
Prod2      P      $15.30      32

I would like it to look like this(the headers don't matter I can create the table with the headers I need, I just need to be able to insert the above records to become the records below). Also this is not something that will only be done once. The query that created the table below will be run every week so "use Excel to transpose" won't work here.

MINumber PL1 Calc1 Percent PL2       Calc2      Percent PL3      Calc3      Percent PL4 Calc Percent
Prod1 B $16.69 5 K       $14.06      20 L $13.35      24 P $12.30 30
Prod2 B $18.69 5 K       $16.06      20 L $19.35      28 P $15.30 32

Any help would be appreciated!

Rey Obrero (Capricorn1)

you will need vba codes to do this.

LBarrett

ASKER

I thought as much and tried a few that I saw here but I couldn't find one that was quite what I was looking for. Can you get me started and maybe even finished with this? If points are too low for the time needed I will gladly adjust.

Rey Obrero (Capricorn1)

place this codes in module

you have to add to your references
Tools >references
Microsoft DAO x.x object library { x.x is the version available }

change tblData with the actual name of table

after running the codes open the created table newTblData

Sub createFlatTable()
Dim rs As DAO.Recordset, j As Integer, i, sPL As String, sFld
Dim rsMax As DAO.Recordset, rsNew As DAO.Recordset, maxProd
Dim rs1 As DAO.Recordset
Set rsMax = CurrentDb.OpenRecordset("select top 1 count(MINumber) from tblData group by MINumber order by count(MINumber) desc")
maxProd = rsMax(0)
For i = 1 To maxProd
    sPL = sPL & "," & "PL" & i & " Text" & "," & "Calc" & i & " Text" & ", " & "Percent" & i & " text"
Next
    sPL = mid(sPL, 2)
    sFld = "MINumber Text,"
If Not IsNull(DLookup("[name]", "msysobjects", "[name]='newTblData'")) Then
    CurrentDb.Execute "drop table newtblData"
End If
CurrentDb.Execute "create table newTblData( " & sFld & sPL & ")"
Set rs = CurrentDb.OpenRecordset("select distinct MINumber from tbldata")
Set rsNew = CurrentDb.OpenRecordset("newtbldata")
rs.MoveFirst
Do Until rs.EOF
    Set rs1 = CurrentDb.OpenRecordset("select * from tblData where MINumber='" & rs!MINumber & "'")
    rsNew.AddNew
    rsNew!MINumber = rs1!MINumber
    j = 1
    Do Until rs1.EOF
        rsNew("PL" & j) = rs1!PL
        rsNew("Calc" & j) = rs1!Calc
        rsNew("Percent" & j) = rs1!Percent
        j = j + 1
        rs1.MoveNext
    Loop
    rsNew.Update
rs.MoveNext
Loop
rs.Close
rs1.Close
rsNew.Close
rsMax.Close
 
End Sub

Open in new window

LBarrett

ASKER

Thanks for the fast response. Will not be able to verify this completely until tommorow but the small test I was able to do looked perfect. Will do full test and LYK.

Thank you again.

Kudos capricorn1

RBarrett

The only issue I see is that the Calc fields and Percent fields have become text fields. I need them to remain as currency and percent (or numbers). I will be using them in other calculations. Can you help with this?

LBarrett

ASKER

ASKER CERTIFIED SOLUTION

Rey Obrero (Capricorn1)

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

LBarrett

ASKER

That should do it. Response was so quick and the solution worked first time around so I increased the points.

Thanks again!

LBarrett

LBarrett

ASKER

That should do it. Response was so quick and the solution worked first time around so I increased the points.

Thanks again!

LBarrett