Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 436
  • Last Modified:

Transpose Excel Spreadsheet

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
rtgaglia
Asked:
rtgaglia
  • 12
  • 5
1 Solution
 
DhaestCommented:
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
 
rtgagliaAuthor Commented:
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
 
DhaestCommented:
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
Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

 
rtgagliaAuthor Commented:
It is in Access and we want to create an Excel spreadsheet so that the information is transposed?
0
 
DhaestCommented:
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
 
rtgagliaAuthor Commented:
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
 
rtgagliaAuthor Commented:
I have increased the points...
0
 
rtgagliaAuthor Commented:
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
 
DhaestCommented:
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
 
rtgagliaAuthor Commented:
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
 
rtgagliaAuthor Commented:
Is excel_app suppose to be a variable I need to set or is VBA suppose to know what it is?

Thanks,

Ryan
0
 
rtgagliaAuthor Commented:
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
 
DhaestCommented:
You need to reference to excell in your project...
tools - references and there you have to choose Microsoft Excell object library
0
 
rtgagliaAuthor Commented:
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
 
rtgagliaAuthor Commented:
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
 
rtgagliaAuthor Commented:
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
 
rtgagliaAuthor Commented:
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
 
moduloCommented:
PAQed, with points refunded (400)

modulo
Community Support Moderator
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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.

  • 12
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now