Making UnCrossTab Query in Access w/ VBA

[BKSwindell]

Hey guys, I need help converting a speadsheet into a proper data source. I have imported it in to a table called "B" in access 2007. The problem is that the data is spead out of multible columns and rows, looks like a crosstab query. I need to convert it back to its data. I could do it with UNION Queries but this would be unpractical due to the number of columns. I would like to use some code that I have found in an old post: http://www.access-programmers.co.uk/...ad.php?t=28110. 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'.

on this line:

Set rstout = CurrentDb.OpenRecordset("BOut", dbOpenDynaset)

Here is my first try:
I have a table called "B":

InvoiceCode,XXX001,XXX002,XXX003,...
A,$10,$15,$20,...
B,$1,$2,3$,...
...,...,...,...,...

And like the other post, I too would like it my data to look like:

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

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

 
SELECT UnCrossTab_Price()
FROM BOut;

This is my module:

Option Compare Database
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

[BKSwindell]

Fixed: The output must be to a table, updated code to build a table with the output. Then query the table.

Option Compare Database
Public Sub UnCrossTab_Price()
On Error GoTo Err_UnCrossTab_Price
Dim db As DAO.Database
Dim tblNew As DAO.TableDef
Dim fld As DAO.Field
Dim IndexNumber As Integer
Dim rstin As DAO.Recordset
Dim rstout As DAO.Recordset
Dim fieldloop As Integer
Set db = CurrentDb
Set tblNew = db.CreateTableDef("BOut")
Set fld = tblNew.CreateField("INVOICECODE", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("DEALERCODE", dbText)
tblNew.Fields.Append fld
Set fld = tblNew.CreateField("PRICE", dbCurrency)
tblNew.Fields.Append fld
db.TableDefs.Append tblNew
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
Exit_UnCrossTab_Price:
    Exit Sub
Err_UnCrossTab_Price:
    If Err.Number = 3265 Then
        Resume Next
    Else
        MsgBox Err.Description
        Resume Exit_UnCrossTab_Price
    End If
End Sub

Brad Swindell