Solved

Transpose Excel Spreadsheet

Posted on 2004-03-23
20
405 Views
Last Modified: 2013-12-25
I have a spreadsheet that contains about 50 items. The list comes in as a field name and directly underneath it has the value. The problem is the list goes horizontal! We need the list to populate vertically so that we can paste it into a spreadsheet and determine if there are any errors without scrolling to the right. Can anyone help. I started to create a sub and get it to loop through it but I did not get very far at all. The Sub below does not store the information or anything. We also need new information to be overwritten each day. This is what I have thus far:

Sub Transposed()
    Dim dbs As Database, rst As Recordset, X As Integer, Y As String
    Dim strSQL As String

    ' Return reference to current database.
    Set dbs = CurrentDb
    strSQL = "SELECT * FROM Consolidated"
    Set rst = dbs.OpenRecordset(strSQL)
   
    Do While X <> EOF
       
        FieldName = rst.Fields(X).Value
        FieldValue = rst.Fields(X).Name
        rst.MoveNext
       
   
    Loop
   
    rst.Close
    Set dbs = Nothing
End Sub


Any help would be greatly appreciated.

Thanks,

Ryan Gagliano
0
Comment
Question by:rtgaglia
  • 12
  • 5
20 Comments
 
LVL 53

Expert Comment

by:Dhaest
Comment Utility
What exactly do you mean ? Can you give a little example of the layout of how it's now and how it has to be !

While rst.eof = false
        FieldName = rst.Fields(X).Value
        FieldValue = rst.Fields(X).Name
        rst.MoveNext
        Y = Fieldname & " " & FieldValue & vbcrlf
wend
0
 

Author Comment

by:rtgaglia
Comment Utility
Here is an example of what is looks like currently:

              A                                                                B                                                   C
1         3RD PTY BEG BALANCE                        CM 3RD BEG COUNT         3RD PTY CHG BAL
2            100000                                                      50                                                    5

This is what we want it to look like:
                              A                                    B
1            3RD PTY BEG BALANCE                  100000
2            CM 3RD BEG COUNT                          50
3            3RD PTY CHG BALANCE                        5
0
 
LVL 53

Expert Comment

by:Dhaest
Comment Utility
If it's in excell, why don't you use an excell function for it ?
Transpose rows to columns or columns to rows
Data from the top row of the copy area appears in the left column of the paste area, and data from the left column appears in the top row.

Select the cells that you want to switch.
Click Copy .
Select the upper-left cell of the paste area. The paste area must be outside the copy area.
Click the arrow to the right of Paste  and then click Transpose.

Recorded as a macro:
' What columns and rows must be transformed ?
    Range("A1:C2").Select
' Copy it
    Selection.Copy
' At which place must it come ?
    Range("A4").Select
' Transform it
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
0
 

Author Comment

by:rtgaglia
Comment Utility
It is in Access and we want to create an Excel spreadsheet so that the information is transposed?
0
 
LVL 53

Expert Comment

by:Dhaest
Comment Utility
Use a Recordset to copy data from an Access database into an Excel workbook

Private Sub cmdLoad_Click()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim excel_app As Excel.Application
Dim excel_sheet As Excel.Worksheet

    Screen.MousePointer = vbHourglass
    DoEvents

    ' Open the Access database.
    Set conn = New ADODB.Connection
    conn.ConnectionString = _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & txtAccessFile.Text
    conn.Open

    ' Select the Access data.
    Set rs = conn.Execute("Books")

    ' Create the Excel application.
    Set excel_app = CreateObject("Excel.Application")

    ' Uncomment this line to make Excel visible.
'    excel_app.Visible = True

    ' Open the Excel workbook.
    excel_app.Workbooks.Open txtExcelFile.Text

    ' Check for later versions.
    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If

    ' Use the Recordset to fill the table.
    excel_sheet.Cells.CopyFromRecordset rs
    excel_sheet.Cells.Columns.AutoFit

    ' Save the workbook.
    excel_app.ActiveWorkbook.Save

    ' Shut down.
    excel_app.Quit
    rs.Close
    conn.Close

    Screen.MousePointer = vbDefault
    MsgBox "Ok"
End Sub
0
 

Author Comment

by:rtgaglia
Comment Utility
For this:

excel_app As Excel.Application

I receive an error that says user defined type is not defined. I also modifeied the code as followed:

Private Sub cmdLoad_Click()
Dim dbs As Database
Dim strSQL As String
Dim rs As Recordset
Dim excel_app As Excel.Application
Dim excel_sheet As Excel.Worksheet

    Screen.MousePointer = vbHourglass
    DoEvents

    Set dbs = CurrentDb
    strSQL = "SELECT * FROM Consolidated"
    Set rst = dbs.OpenRecordset(strSQL)

    ' Create the Excel application.
    Set excel_app = CreateObject("Excel.Application")

    ' Uncomment this line to make Excel visible.
'    excel_app.Visible = True

    ' Open the Excel workbook.
    excel_app.Workbooks.Open txtExcelFile.Text

    ' Check for later versions.
    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If

    ' Use the Recordset to fill the table.
    excel_sheet.Cells.CopyFromRecordset rs
    excel_sheet.Cells.Columns.AutoFit

    ' Save the workbook.
    excel_app.ActiveWorkbook.Save

    ' Shut down.
    excel_app.Quit
    rs.Close
    conn.Close

    Screen.MousePointer = vbDefault
    MsgBox "Ok"
End Sub
0
 

Author Comment

by:rtgaglia
Comment Utility
I have increased the points...
0
 

Author Comment

by:rtgaglia
Comment Utility
The table the information is housed in Access is called Consolidated. But the table does not house the information vertically, it is in the table horizontally. This is fine and I can still get everything to work but I need it in a nice and neat fashion so that my boss can look at it and read over the list without scrolling to the side.
0
 
LVL 53

Expert Comment

by:Dhaest
Comment Utility
A made a module in my database and used this code to perform it...

Sub transpose()
    DeleteFile
    Access.DoCmd.OutputTo acOutputTable, "Consolidated", acFormatXLS, "c:\test.xls", False
    DoTranspose
End Sub

Sub DeleteFile()
    Dim fso
    Dim file As String
    file = "C:\test.xls" ' change to match the file w/Path
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(file) Then
        fso.DeleteFile file, True
    Else
        MsgBox file & " does not exist or has already been deleted!" _
                , vbExclamation, "File not Found"
    End If
End Sub

Sub DoTranspose()
Dim strFromSheet As String
Dim strToSheet As String
Dim iLast As Integer
Dim iLastCol As Integer
Dim strHolder As String

    Set excel_app = CreateObject("Excel.Application")
    excel_app.Workbooks.Open "c:\test.xls"
    excel_app.Visible = True
   
    excel_app.Range("A1").Select
    excel_app.ActiveCell.SpecialCells(xlLastCell).Select
    iLast = excel_app.ActiveCell.row
    iLastCol = excel_app.ActiveCell.Column
       
    strFromSheet = excel_app.ActiveSheet.Name
   
    excel_app.Sheets.Add
    strToSheet = excel_app.ActiveSheet.Name

    excel_app.Sheets(strFromSheet).Select
    excel_app.Range("A1").Select
    While excel_app.ActiveCell.Column <= iLastCol
        While excel_app.ActiveCell.row <= iLast
            If excel_app.ActiveCell = "" Then
                excel_app.Sheets(strToSheet).Select
                excel_app.Range(ActiveCell.Column + 1 & ActiveCell.row + 1).Select
            Else
                strHolder = excel_app.ActiveCell.Value
                excel_app.Sheets(strToSheet).Select
                excel_app.ActiveCell.Value = strHolder
                excel_app.ActiveCell.Offset(0, 1).Select
            End If
            excel_app.Sheets(strFromSheet).Select
            excel_app.ActiveCell.Offset(1, 0).Select
        Wend
        excel_app.Sheets(strToSheet).Activate
        excel_app.ActiveCell.SpecialCells(xlLastCell).Select
        excel_app.Range("A" & excel_app.ActiveCell.SpecialCells(xlLastCell).row + 1).Select
        excel_app.Sheets(strFromSheet).Select
        excel_app.Range(Chr(Asc(excel_app.ActiveCell.Column) + 17) & "1").Select
         
    Wend
    excel_app.Sheets(strToSheet).Select
End Sub
0
Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 

Author Comment

by:rtgaglia
Comment Utility
I get a varibale not defined for excel_app in the DoTranspose sub. I am using VBA for Access 1997. Will this still work?

0
 

Author Comment

by:rtgaglia
Comment Utility
Is excel_app suppose to be a variable I need to set or is VBA suppose to know what it is?

Thanks,

Ryan
0
 

Author Comment

by:rtgaglia
Comment Utility
I added it as a varaible

Dim excel_app As Excel.Application

I still get the errror message:

Compile Error: User-defined type not defined.

Is this something wrong with Access 97?
0
 
LVL 53

Expert Comment

by:Dhaest
Comment Utility
You need to reference to excell in your project...
tools - references and there you have to choose Microsoft Excell object library
0
 

Author Comment

by:rtgaglia
Comment Utility
I ran the query and added the Excel 8.0 Object Library and I still receive teh error message variable not defined for excel_app. Do I need to make this a variable?

Here is the code:

Sub transpose()
    DeleteFile
    Access.DoCmd.OutputTo acOutputTable, "Consolidated", acFormatXLS, "M:\Servicin\Systems\ScoreCard\Results\Scorecard Paste " & [Forms]![Selection Form]![Text54], False
    DoTranspose
End Sub

Sub DeleteFile()
    Dim fso
    Dim file As String
    file = "M:\Servicin\Systems\ScoreCard\Results\Scorecard Paste " & [Forms]![Selection Form]![Text54]
    Set fso = CreateObject("Scripting.FileSystemObject")
    If fso.FileExists(file) Then
        fso.DeleteFile file, True
    Else
        MsgBox file & " does not exist or has already been deleted!" _
                , vbExclamation, "File not Found"
    End If
End Sub

Sub DoTranspose()
Dim strFromSheet As String
Dim strToSheet As String
Dim iLast As Integer
Dim iLastCol As Integer
Dim strHolder As String


    Set excel_app = CreateObject("Excel.Application")
    excel_app.Workbooks.Open "M:\Servicin\Systems\ScoreCard\Results\Scorecard Paste " & [Forms]![Selection Form]![Text54]
    excel_app.Visible = True
   
    excel_app.Range("A1").Select
    excel_app.ActiveCell.SpecialCells(xlLastCell).Select
    iLast = excel_app.ActiveCell.row
    iLastCol = excel_app.ActiveCell.Column
       
    strFromSheet = excel_app.ActiveSheet.Name
   
    excel_app.Sheets.Add
    strToSheet = excel_app.ActiveSheet.Name

    excel_app.Sheets(strFromSheet).Select
    excel_app.Range("A1").Select
    While excel_app.ActiveCell.Column <= iLastCol
        While excel_app.ActiveCell.row <= iLast
            If excel_app.ActiveCell = "" Then
                excel_app.Sheets(strToSheet).Select
                excel_app.Range(ActiveCell.Column + 1 & ActiveCell.row + 1).Select
            Else
                strHolder = excel_app.ActiveCell.Value
                excel_app.Sheets(strToSheet).Select
                excel_app.ActiveCell.Value = strHolder
                excel_app.ActiveCell.Offset(0, 1).Select
            End If
            excel_app.Sheets(strFromSheet).Select
            excel_app.ActiveCell.Offset(1, 0).Select
        Wend
        excel_app.Sheets(strToSheet).Activate
        excel_app.ActiveCell.SpecialCells(xlLastCell).Select
        excel_app.Range("A" & excel_app.ActiveCell.SpecialCells(xlLastCell).row + 1).Select
        excel_app.Sheets(strFromSheet).Select
        excel_app.Range(Chr(Asc(excel_app.ActiveCell.Column) + 17) & "1").Select
         
    Wend
    excel_app.Sheets(strToSheet).Select
End Sub
0
 

Author Comment

by:rtgaglia
Comment Utility
Ok thanks for the help. I got the basics to work, but a problem occurs. It keeps repeating the values (I would say around 15-20) and never goes all the way through the entire spreadsheet. The spreadsheet contains 188 values. I let the code run and it ran for over 240 values until I finally forced it to stop. Any suggestions?
0
 

Author Comment

by:rtgaglia
Comment Utility
Actually I stepped through the code and noticed that it is only going through the first ten records.  Does anyone know why?

Other than that it works properly.

Thanks,

Ryan
0
 

Author Comment

by:rtgaglia
Comment Utility
While stepping through the code I noticed on this line:

It has a value of 11.

I checked in Excel and the real last cell should be GF.

Does anyone have any suggestions.

Thanks,

Ryan
0
 

Accepted Solution

by:
modulo earned 0 total points
Comment Utility
PAQed, with points refunded (400)

modulo
Community Support Moderator
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now