Link to home
Start Free TrialLog in
Avatar of Juan Velasquez
Juan VelasquezFlag for United States of America

asked on

Storing Cross tab data in normalize form and then displaying back as cross tab

Hello,
Here is the problem.  I've created a table that stores cross tab data via a make table query.  As a consequence, the number of fields in the table can vary.  The user wants to be able to archive this data and to be able to retrieve specific cross-tab reports.
The cross tab data stored in the cross tab table is formatted as follows
tbl_Internal_Report
ItemNumber      GrandTotal        X           Y          Z
  ABC                        8                 2           3         3

It appears that in order to store this data in an archive table, it must be stored in a normalized table owing to the fact that the number columns to the right of GrandTotal is dynamic
tbl_Internal_Report_Archive
ItemNumber  ABC      ABC      ABC
GrandTotal      8           8         8    
Sub                 X            Y        Z
NA-Qty             2           3        3

I found the attached code in experts-exchange and I modified it.  However,  I am uable to populate the NA-Qty fields in tbl_Internal_Report_Archive.  I had thought of just importing the data from the underlying crosstab query into the table tbl_Internal_Report_Archive, but the user needs to be able to make changes to the crosstab output - which is why I created the table tbl_Internal_Report to hold this data.  The changes that the user makes must be archived.


Dim rs As DAO.Recordset, rs1 As DAO.Recordset, rst As DAO.Recordset
Dim i As Integer,  sql As String
Set rs = CurrentDb.OpenRecordset("tbl_Internal_Report")       '<<< change to name of table with crosstab data
Set rst = CurrentDb.OpenRecordset("tbl_Internal_Report_Archive")     '<<< change to name of table
 
    For i = 20 To rs.Fields.Count - 1
    'Debug.Print rs.Fields(i).Name
        
        sql = "select Site, [Item-Number],[AFS Part Number/Item],[Ful Description],[Ful Product Code],[Previous Day Shtg Qty],[Piv Comments],[Internal Order Comments],[AP 1-6],[AP 7-10], [AP 11-15],[Action],[Pin Status],[Assy Status],[WIP Comments],[AFS Total WIP Qty], [AFS Original ECD],[AFS Revised ECD],[AFS Comments],[Grand Total],[" & rs(i).Name & "]  from [tbl_Internal_Report]"
        Debug.Print sql
        Set rs1 = CurrentDb.OpenRecordset(sql)
        If Not rs1.EOF Then
        rs1.MoveFirst
            Do Until rs1.EOF
                With rst
                    .AddNew
                    .Fields("Site") = rs1("Site")
                    .Fields("Item-Number") = rs1("Item-Number")
                    .Fields("AFS Part Number/Item") = rs1("AFS Part Number/Item")
                    .Fields("Ful Description") = rs1("Ful Description")
                    .Fields("Ful Product Code") = rs1("Ful Product Code")
                    .Fields("Previous Day Shtg Qty") = rs1("Previous Day Shtg Qty")
                    .Fields("Piv Comments") = rs1("Piv Comments")
                    .Fields("Grand Total") = rs1("Grand Total")
                    .Fields("Internal Order Comments") = rs1("Internal Order Comments")
                    .Fields("AP 1-6") = rs1("AP 1-6")
                    .Fields("AP 7-10") = rs1("AP 7-10")
                    .Fields("AP 11-15") = rs1("AP 11-15")
                    .Fields("Action") = rs1("Action")
                    .Fields("Pin Status") = rs1("Pin Status")
                    .Fields("Assy Status") = rs1("Assy Status")
                    .Fields("WIP Comments") = rs1("WIP Comments")
                    .Fields("AFS Total WIP Qty") = rs1("AFS Total WIP Qty")
                    .Fields("AFS Revised ECD") = rs1("AFS Revised ECD")
                    .Fields("AFS Comments") = rs1("AFS Comments")
                    .Fields("Sub") = rs(i).Name
                    .Fields("NA-Qty") = rs(i).Value
                    'Debug.Print rs1(19).Name
                    .Fields("Archive_Date") = Date & " " & Time
                    .Update
 
                End With
                rs1.MoveNext
            Loop
        End If
    Next
 
rs.Close
rst.Close
rs1.Close
 
End Function

Open in new window

Avatar of GRayL
GRayL
Flag of Canada image

You cannot have identically named fields ABC??
Avatar of Juan Velasquez

ASKER

ABC are the values that are stored in the item number field of the table tbl_Internal_Report.  However, the layout of tbl_Internal_Report_Archive was misleading.  Below is the corrected table

Item Number  GrandTotal   Sub      NA-Qty
abc                       8               X           2
abc                       8               Y           3  
abc                       8               Z           3
Can you show us one or two of the cross tab query results before the transformation?
Sure thing,  owing to the number of fields I've simplified the number of fields.

Below are two example of the cross tab results that are store via a make table query into tbl_Internal_Report.  As you can see the number of columns after GrandTotal may vary.  Does this example help.

ItemNumber      GrandTotal        X           Y          Z
  ABC                        8                 2           3         3
  def                        14                 1           4         9
  jkh                          4                 2           1         1

ItemNumber      GrandTotal        X           Y          Z      AA
  ABC                        8                 2           3         3        2
  def                         17                 1           4         9        3
  jkh                          5                 2           1         1        1
I have modified the sql string.  I found that I was getting a record for each value of rs(i).name even if there were no quantity in rs(i).name.  However I'm still not able to populate the NA-Qty fields
Function TransposeXtab()
 
Dim rs As DAO.Recordset, rs1 As DAO.Recordset, rst As DAO.Recordset
Dim i As Integer, xDate, sql As String
Set rs = CurrentDb.OpenRecordset("tbl_Internal_Report")       '<<< change to name of table with crosstab data
Set rst = CurrentDb.OpenRecordset("tbl_Internal_Report_Archive")     '<<< change to name of table
Dim strNAQty As String
 
    For i = 20 To rs.Fields.Count - 1
    'Debug.Print rs.Fields(i).Name
      
        sql = "select Site, [Item-Number],[AFS Part Number/Item],[Ful Description],[Ful Product Code],[Previous Day Shtg Qty],[Piv Comments],[Internal Order Comments],[AP 1-6],[AP 7-10], [AP 11-15],[Action],[Pin Status],[Assy Status],[WIP Comments],[AFS Total WIP Qty], [AFS Original ECD],[AFS Revised ECD],[AFS Comments],[Grand Total],[" & rs(i).Name & "]from [tbl_Internal_Report] where [" & rs(i).Name & "] IN(Select[" & rs(i).Name & "]from [tbl_Internal_Report])"
        Debug.Print sql
        Set rs1 = CurrentDb.OpenRecordset(sql)
       
       
            Debug.Print rs(i).Name
        
     
        If Not rs1.EOF Then
        rs1.MoveFirst
            Do Until rs1.EOF
                With rst
                    .AddNew
                    .Fields("Site") = rs1("Site")
                    .Fields("Item-Number") = rs1("Item-Number")
                    .Fields("AFS Part Number/Item") = rs1("AFS Part Number/Item")
                    .Fields("Ful Description") = rs1("Ful Description")
                    .Fields("Ful Product Code") = rs1("Ful Product Code")
                    .Fields("Previous Day Shtg Qty") = rs1("Previous Day Shtg Qty")
                    .Fields("Piv Comments") = rs1("Piv Comments")
                    .Fields("Grand Total") = rs1("Grand Total")
                    .Fields("Internal Order Comments") = rs1("Internal Order Comments")
                    .Fields("AP 1-6") = rs1("AP 1-6")
                    .Fields("AP 7-10") = rs1("AP 7-10")
                    .Fields("AP 11-15") = rs1("AP 11-15")
                    .Fields("Action") = rs1("Action")
                    .Fields("Pin Status") = rs1("Pin Status")
                    .Fields("Assy Status") = rs1("Assy Status")
                    .Fields("WIP Comments") = rs1("WIP Comments")
                    .Fields("AFS Total WIP Qty") = rs1("AFS Total WIP Qty")
                    .Fields("AFS Revised ECD") = rs1("AFS Revised ECD")
                    .Fields("AFS Comments") = rs1("AFS Comments")
                    .Fields("Sub") = rs(i).Name
                    '.Fields("NA-Qty") = rs(i).Value
                    'Debug.Print rs1(19).Name
                    .Fields("Archive_Date") = Date & " " & Time
                    .Update
 
                End With
                rs1.MoveNext
            Loop
        End If
    Next
 
rs.Close
rst.Close
rs1.Close
 
End Function

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Rey Obrero (Capricorn1)
Rey Obrero (Capricorn1)
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
If there are up to ten fields in each of the tables, make the first SELECT statement of a UNION query with:

SELECT ItemNumber, GrandTotal, A, B, C, "" AS F1, "" AS F2, "" AS F3, etc. FROM T1
Union
<Repeat for each cross tab using the same field references as above>
Thanks Capricorn1
I will go ahead and try it when I get home.  I'll let you know what happens.  Thanks again
Hello Capricorn,

I modified the code you gave me, due to the additional columns that I didn't describe in the initial email.  The modified code is below.  After executing it, I am still not able to populate the NA-Qty field.   I outputted the outputted data set as an excel file and have attached it.  As you can see the Grand Total and NA-Qty values are displayed with the same values
Sub chtullu135Transpose()
Dim rs As DAO.Recordset, rs1 As DAO.Recordset
Dim i As Integer, s, fldArr()
 
Set rs = CurrentDb.OpenRecordset("tbl_Internal_Report")
Set rs1 = CurrentDb.OpenRecordset("tbl_Internal_Report_Archive")
 
If rs.EOF Or rs.BOF Then
    MsgBox "no records"
    Exit Sub
End If
rs.MoveFirst
    For i = 0 To rs.Fields.Count - 1
        ReDim Preserve fldArr(i)
        fldArr(i) = rs.Fields(i).Name
    Next
Dim j
Do Until rs.EOF
    For j = 21 To UBound(fldArr)
        If rs(fldArr(j)).Value > 0 Then
            With rs1
                .AddNew
                ![Site] = rs("Site")
                ![Item-Number] = rs("Item-Number")
                ![AFS Part Number/Item] = rs("AFS Part Number/Item")
                ![Ful Description] = rs("Ful Description")
                ![Ful Product Code] = rs("Ful Product Code")
                ![Previous Day Shtg Qty] = rs("Previous Day Shtg Qty")
                ![Piv Comments] = rs("Piv Comments")
                ![Grand Total] = rs("Grand Total")
                ![Internal Order Comments] = rs("Internal Order Comments")
                ![AP 1-6] = rs("AP 1-6")
                ![AP 7-10] = rs("AP 7-10")
                ![AP 11-15] = rs("AP 11-15")
                ![Action] = rs("Action")
                ![Pin Status] = rs("Pin Status")
                ![Assy Status] = rs("Assy Status")
                ![WIP Comments] = rs("WIP Comments")
                ![AFS Total WIP Qty] = rs("AFS Total WIP Qty")
                ![AFS Revised ECD] = rs("AFS Revised ECD")
                ![AFS Comments] = rs("AFS Comments")
               
                !Sub = rs.Fields(fldArr(j)).Name
                ![NA-Qty] = rs.Fields(fldArr(j)).Value
                .Update
                
               
               
            End With
        End If
    Next
    rs.MoveNext
Loop
rs.Close
rs1.Close
End Sub

Open in new window

tbl-Internal-Report-Archive.xls
Hello Capricorn1,

Never mind, I checked the Outputted file and it looks like it is giving me the desired results.  I'll double check it tomorrow at work.  But I think that your suggested code is working fine.  I'll touch base with you tomorrow.  Thanks again.
Thanks for the help.  Everything is up and running