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
Solved

Transpose Excel Spreadsheet

Posted on 2004-03-23
20
424 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
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
Free Tool: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 

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

Active Directory Webinar

We all know we need to protect and secure our privileges, but where to start? Join Experts Exchange and ManageEngine on Tuesday, April 11, 2017 10:00 AM PDT to learn how to track and secure privileged users in Active Directory.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Run code from text file in vb 1 73
Crystal reports - Formula Field code need assistance with code 17 83
Child Form in front 4 49
VB 6 error 5 in windows 10 but not in XP 7 63
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
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…

829 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