Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Transpose Excel Spreadsheet

Posted on 2004-03-23
20
Medium Priority
?
430 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 12
  • 5
20 Comments
 
LVL 53

Expert Comment

by:Dhaest
ID: 10664768
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
ID: 10667891
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
ID: 10668018
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
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:rtgaglia
ID: 10668042
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
ID: 10668121
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
ID: 10668281
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
ID: 10671171
I have increased the points...
0
 

Author Comment

by:rtgaglia
ID: 10671781
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
ID: 10674861
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
 

Author Comment

by:rtgaglia
ID: 10676984
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
ID: 10716065
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
ID: 10717048
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
ID: 10721038
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
ID: 10725019
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
ID: 10736670
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
ID: 10736712
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
ID: 10736731
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
ID: 11300039
PAQed, with points refunded (400)

modulo
Community Support Moderator
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Suggested Courses

721 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