View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
polisci grad polisci grad is offline
external usenet poster
 
Posts: 1
Default Convert Table Formats

Disclaimer: I have minimal experience with Excel.

I would like to write a 'macro' (little program?) to convert one table
format to another. I have one large file with about 68 worksheets. On each
worksheet is a different table, but they are all in essentially the same
format. This is as follows:

DATE ITEMNAME1 ITEMNAME2 .....etc
12/1/2005 50 25
12/1/2006 60 40
.....etc

Each table has a different amount of items, all with unique names. What I
need to happen is for all tables to be converted to this:

ITEMNAMES DATE VALUE
WORKSHEETNAME_ITEMNAME1 12/1/2005 50
WORKSHEETNAME_ITEMNAME1 12/1/2006 60
WORKSHEETNAME_ITEMNAME2 12/1/2005 25
WORKSHEETNAME_ITEMNAME2 12/1/2006 40
.....etc.

Then I need all the separate worksheets collated into one large, long, flat
file. I've written a program in Access VBA to accomplish this, since I used
to import each worksheet into an Access DB. .However, I think it would be
easier for me to just run the macro from Excel, and link the result into
Access (saves all the importing).

My problem is I have no idea about were in Excel to put this stuff, how to
run the program, reference worksheets, etc. Any suggestions would be greatly
appreciated.

Here is the code I wrote:
Private Sub Command0_Click()
Dim newtbl As Recordset
Dim rs As Recordset
Dim db As Database
Dim tblnme As String
Dim fldnme As String
Dim rwsrce As String
Dim dt As Variant
Dim vl As Variant
Dim intloop As Integer
Dim tbl As TableDef



Set db = CurrentDb

For Each tbl In db.TableDefs
tblnme = tbl.Name

Set rs = db.OpenRecordset(tblnme)
Set newtbl = db.OpenRecordset("Trial")

If tbl.Attributes = 0 And tbl.Name < "Trial" Then

For intloop = 1 To rs.Fields.Count - 1

Do Until rs.EOF = True

With newtbl
.AddNew
!Key = tblnme & "_" & rs.Fields(intloop).Name
!Date = rs!Date
!Value = rs.Fields(intloop).Value
.Update
End With

rs.MoveNext
Loop

rwsrce = rwsrce & fldnme
rs.MoveFirst

Next intloop

End If

Next tbl

Set db = Nothing
Set rs = Nothing
Set newtbl = Nothing


End Sub