Solution: Kind of 'UnCrosstab' code

A

Atomic Shrimp

Humanoid lifeform
Local time
Today, 11:48
Joined
Jun 16, 2000
Messages
1,954
I've often wanted code that would take a table with any number of fields, say:

Store,SalesJan,SalesFeb,SalesMar,SalesApr
1,100,150,170,120
2,50,75,90,80

And convert it to a format like:

Store, Month, SalesValue
1,Jan,100
1,Feb,150
1,Mar,170
1,Apr,120
2,Jan,50
2,Feb,75
2,Mar,90
2,Apr,80

The other day, I figured out how to do it; here's the code:
Code: 
Dim db As Database
Dim rstin As Recordset
Dim rstout As Recordset
Dim strsql As String
Dim recordloop As Integer
Dim fieldloop As Integer


Set db = CurrentDb()

strsql = "SELECT [SalesIn].* FROM [SalesIn];"
Set rstin = db.OpenRecordset(strsql, dbOpenSnapshot)
Set rstout = db.OpenRecordset("SELECT SalesOut.* FROM SalesOut;", dbOpenDynaset)

rstin.MoveLast
rstin.MoveFirst
For recordloop = 1 To rstin.RecordCount
    For fieldloop = 0 To rstin.Fields.Count - 1
    If (rstin.Fields(fieldloop).Name Like "Sales*") Then
        With rstout
            .AddNew
            !Store = rstin!Store.Value
            !SalesValue = rstin.Fields(fieldloop).Value
            !Month = Mid(rstin.Fields(fieldloop).Name,6)
'NB the Mid Statement above just chops off 'Sales' from the fieldname to leave the name of the month
            .Update
        End With
    End If
    Next fieldloop

rstin.MoveNext
Next recordloop
db.Close
 
I'd love to use this code, but I'm not sure where to go in Access to add the code. I know, completely dumb question.
 
Code: 
Dim rstin As DAO.Recordset
Dim rstout As DAO.Recordset
Dim fieldloop As Integer

Set rstin = CurrentDb.OpenRecordset("SalesIn", dbOpenSnapshot)
Set rstout = CurrentDb.OpenRecordset("SalesOut", dbOpenDynaset)

If Not rstin.EOF And Not rstin.BOF Then
   Do Until rstin.EOF

      For fieldloop = 0 To rstin.Fields.Count - 1
           If (rstin.Fields(fieldloop).Name Like "Sales*") Then
              With rstout
                 .AddNew
                 !Store = Nz(rstin!Store,0)
                 !SalesValue = Nz(rstin.Fields(fieldloop),0)
                 !Month = Mid(rstin.Fields(fieldloop).Name,6)
                'NB the Mid Statement above just chops off 'Sales' from the  fieldname to leave the name of the month
                .Update
           End With
         End If
      Next fieldloop

      rstin.MoveNext
   Loop

   rstin.Close
   rstout.Close
End If

Set rstin = Nothing
Set rstout = Nothing

Mike just tidied up your code a bit (hope you don't mind).


Kooshter
To utilise this code you would need to insert it into a public function in a standard module and modify the tables and queries to suit your needs. Then you would fire it off, say from a command button on a form by issuing the following code

Call <<NameOfFunction>>


David
 
Hey guys I know this is an old post... but I wanted to give credit for the code. I was wondering if you could expand on how to utilize this code. I have created a public function in my module. But I am not sure on how to call it. I get the error:
Circular reference caused by 'BOut'.
Click to expand...
on this line:
Code: 
Set rstout = CurrentDb.OpenRecordset("BOut", dbOpenDynaset)

I have a table called "B"
InvoiceCode,XXX001,XXX002,XXX003,...
A,$10,$15,$20,...
B,$1,$2,3$,...
...,...,...,...,...
Click to expand...

And as before I too would like it:

InvoiceCode,DealerCode,Price
A,XXX001,$10
A,XXX002,$15
A,XXX003,$20
A,...,...
B,XXX001,$1
B,XXX002,$2
B,XXX003,$3
B,...,...
...,...,...
Click to expand...

I have created a query called "BOut". This is the SQL:

Code: 
SELECT UnCrossTab_Price()
FROM BOut;

This is my module:

Code: 
Public Function UnCrossTab_Price()
  Dim rstin As DAO.Recordset
  Dim rstout As DAO.Recordset
  Dim fieldloop As Integer
  Set rstin = CurrentDb.OpenRecordset("B", dbOpenSnapshot)
  Set rstout = CurrentDb.OpenRecordset("BOut", dbOpenDynaset)
  If Not rstin.EOF And Not rstin.BOF Then
    Do Until rstin.EOF
      For fieldloop = 0 To rstin.Fields.Count - 1
        If (rstin.Fields(fieldloop).Name Like "XXX*") Then
          With rstout
            .AddNew
            !InvoiceCode = Nz(rstin!InvoiceCode, 0)
            !DealerCode = rstin.Fields(fieldloop).Name
            !Price = Nz(rstin.Fields(fieldloop), 0)
            .Update
          End With
        End If
      Next fieldloop
      rstin.MoveNext
    Loop
    rstin.Close
    rstout.Close
  End If
  Set rstin = Nothing
  Set rstout = Nothing
End Function

Thank you for any help you guys can offer.

Brad Swindell
 
Waking this thing up from the dead.

I am using this code and it is working great with the exception of one issue. Here is what I am using for code:

Code: 
Option Compare Database

Public Function ReverseCrosstab()

Dim rstin As DAO.Recordset
Dim rstout As DAO.Recordset
Dim fieldloop As Integer

Set rstin = CurrentDb.OpenRecordset("query3", dbOpenSnapshot)
Set rstout = CurrentDb.OpenRecordset("Load_Attribute", dbOpenDynaset)

If Not rstin.EOF And Not rstin.BOF Then
   Do Until rstin.EOF

      For fieldloop = 0 To rstin.Fields.Count - 1
           If Not (rstin.Fields(fieldloop).Name Like "part*") Then
              With rstout
                If Not (Nz(rstin.Fields(fieldloop), 0) = 0) Then
                 .AddNew
                 ![Part Number] = Nz(rstin![Part Number], 0)
                 ![PartGroup] = Nz(rstin![PartGroup], 0)
                 ![Attribute Data] = Nz(rstin.Fields(fieldloop), 0)
                 ![Attribute Title] = (rstin.Fields(fieldloop).Name)
                 .Update
                End If
            End With
         End If
      Next fieldloop

      rstin.MoveNext
   Loop

   rstin.Close
   rstout.Close
End If

Set rstin = Nothing
Set rstout = Nothing

End Function

In the output file there are some numbers in the Attribute Data field. It is changing the format:

.90 becomes 0.9
61.00 becomes 61

I need them to stay in their original format. Can anyone help me out?

ETA 07/23/2021 - I modified the code so it skips the nulls so I updated the code posted here.
 
Last edited:
use the format property for display purposes.

not quite sure what the benefit of this code is - from what I can see, just use a union query
 
CJ_London said:
use the format property for display purposes.

not quite sure what the benefit of this code is - from what I can see, just use a union query
Click to expand...
If you are talking about setting the Property Sheet for the field in the query to something like General Number, Fixed, or Standard with two decimal places I have tried that. It looks like the code converts all the Attribute Data to text.

I have used union queries in the past. I have about twenty fields so I wanted to see if this was a better option.

I also modified the code to skip the null values. I updated the code in my original post.
 
Last edited:
Presume your attribute field in the destination table is numeric ?
 
CJ_London said:
Presume your attribute field in the destination table is numeric ?
Click to expand...
No. Half of the attributes are text and the other half numeric.

I know I can manually go in to each field in the query and write a format statement. I do not want to do that.

The data sets support specific product lines. The one I am working on now has (20) fields. My other product line has (27) fields. Some of the others product lines are much larger. All of them have a mix of text and numbers.

If there is solution to be had at the code level that would be great. Once I get this to work the way I need it I will share it with my co-workers and it will make their lives easier too.
 
Last edited:
Text is text, numbers are numbers, a number in a text field will be text, so you’ll need to either use the format function or down the line convert the text to a number so you can use the format property then ( which is what I do)
 
I figured it out. There format of the numbers was different depending on the field. Examples of what I needed are:
  • 0.90
  • 2.405
  • 61.00
  • 24.05
This is how the data is stored in the table that feeds Query3.

I do not need the Nz function on all the fields so I removed them. I added a Format function to the Attribute Data field and it worked. Here is the code:

Code: 
Option Compare Database

Public Function ReverseCrosstab()

Dim rstin As DAO.Recordset
Dim rstout As DAO.Recordset
Dim fieldloop As Integer

Set rstin = CurrentDb.OpenRecordset("query3", dbOpenSnapshot)
Set rstout = CurrentDb.OpenRecordset("Load_Attribute", dbOpenDynaset)

If Not rstin.EOF And Not rstin.BOF Then
   Do Until rstin.EOF

      For fieldloop = 0 To rstin.Fields.Count - 1
        If Not (rstin.Fields(fieldloop).Name Like "part*") Then
            With rstout
                If Not (Nz(rstin.Fields(fieldloop), 0) = 0) Then
                    .AddNew
                    ![Part Number] = rstin![Part Number]
                    ![PartGroup] = rstin![PartGroup]
                    ![Attribute Data] = Format(rstin.Fields(fieldloop), "0.00#")
                    ![Attribute Title] = (rstin.Fields(fieldloop).Name)
                    .Update
                 End If
              End With
         End If
     Next fieldloop

      rstin.MoveNext
   Loop

   rstin.Close
   rstout.Close
End If

Set rstin = Nothing
Set rstout = Nothing

End Function

I am picking this up as I go along so I do not know if that is the right way to do it but it is working so far.
 
Another question. This is setup to put this data into a table.

Is there a way to call the data up from the module in a query?
 
No. A function called in a query can only return a single value per record.

As I suggested use a union query. You can use vba to build the query and save it if required
 
CJ_London said:
No. A function called in a query can only return a single value per record.

As I suggested use a union query. You can use vba to build the query and save it if required
Click to expand...
I had a union query. I found some issues with the source data and had to make some changes. When I went to run the union query I got an error message. I did not want to go through the 20 separate queries to figure out what worked and what did not.

This data is used to build load sheets. My attribute data sets are not that big but I spoke with a co-worker today. Some of the other product lines have a lot more attributes. He said at least one of them has too many to do in one union query. I believe the limit is (50) unions and then you start getting error messages. He has to do two separate union queries and then uses a third union query to put the data together. That is a pain.

This is a much simpler solution. I can make table and then query off that.
 
EzGoingKev said:
I had a union query. I found some issues with the source data and had to make some changes. When I went to run the union query I got an error message. I did not want to go through the 20 separate queries to figure out what worked and what did not.

This data is used to build load sheets. My attribute data sets are not that big but I spoke with a co-worker today. Some of the other product lines have a lot more attributes. He said at least one of them has too many to do in one union query. I believe the limit is (50) unions and then you start getting error messages. He has to do two separate union queries and then uses a third union query to put the data together. That is a pain.

This is a much simpler solution. I can make table and then query off that.
Click to expand...
Hi. Pardon me for jumping in. I hope I am not out of line, but have you tried or considered using Excel's Power Query?
 
Last edited:
theDBguy said:
Hi. Pardon me for jumping in. I hope I am not out of line, but have you tried or considered using Excel's Power Query?
Click to expand...
Honestly I have never even heard of it.
 
Last edited by a moderator:
EzGoingKev said:
Honestly I have never even heard of it.
Click to expand...
See if this helps any.

Correct method for transposing data from an Excel spreadsheet into an Access table?

Using VBA can someone explain the process I need to follow to transpose the data in the spreadsheet shown in pic1 into a db table laid out as shown in pic2? Cycling through each of the records in the spreadsheet I need to take the StudentID and ClassRef and append to it an ExamPaperID which...
www.access-programmers.co.uk
 
You must log in or register to reply here.

Similar threads

Gasman
nth Day of month
Replies
3
Views
1,279
ebs17
E
smtazulislam
Solved Average Date Setting
2
Replies
33
Views
4,285
CJ_London
C
V
SQL Errror 3021
2
Replies
20
Views
2,622
Gasman
Gasman
Mike_10
"Run-time error '-2147024882 (8007000e)': Out of memory." while building ADO recordset
2
Replies
37
Views
7,890
The_Doc_Man
The_Doc_Man
F
Saving all data to an Access Table using ADODB
Replies
3
Views
2,233
fernando.rosales
F

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom