PDA

View Full Version : Fixing Column Widths After Importing Data



gimli
03-25-2010, 08:53 AM
Hi,

Im running a macro that imports data from another excel file and places the data on sheet 3. Im am pulling some of the data to sheet 1 using =Sheet3!D8 for example.

I have the sheet 1 column widths set up the way it looks presentable. The problem is every time I run the macro to bring in the data to sheet 3 all the column widths change on sheet 1.

Can anyone help me with fixing the column widths on sheet 1 so the never change?

thanks much ahead of time.

mdmackillop
03-25-2010, 11:06 AM
You can always record and reset them


Dim i As Long
Dim arr(4)
For i = 1 To 5
arr(i - 1) = Columns(i).ColumnWidth
Next

'Import your data

For i = 1 To 5
Columns(i).ColumnWidth = arr(i - 1)
Next

gimli
03-25-2010, 11:14 AM
You mean like this? I get "invalid outside procedure" compile error...
Im not a VBA guy...:confused2



Option Explicit
Dim i As Long
Dim arr(4)
For i = 1 To 5
arr(i - 1) = Columns(i).ColumnWidth
Next
Sub GetDataDemo()
Dim FilePath$, Row&, Column&, Address$, Ray(1 To 40, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "test.xls" ' Change to suit
Const SheetName$ = "test" ' This is the sheet data retrieved From
Const NumRows& = 40 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Sheet3").Range("C3").Resize(40, 27) = Ray 'Change(10,10), to suit columns and rows
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function
For i = 1 To 5
Columns(i).ColumnWidth = arr(i - 1)
Next

mdmackillop
03-25-2010, 11:22 AM
Option Explicit

Sub GetDataDemo()
Const Cols = 50 '<== Adjust as required
Dim i As Long
Dim arr(Cols - 1)

'Record column widths
For i = 1 To Cols
arr(i - 1) = Columns(i).ColumnWidth
Next

'Call macro to get data
Call GetMyData

'Reinstate column widths
For i = 1 To Cols
Columns(i).ColumnWidth = arr(i - 1)
Next
End Sub

Private Sub GetMyData()
Dim FilePath$, Row&, Column&, Address$, Ray(1 To 40, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "test.xls" ' Change to suit
Const SheetName$ = "test" ' This is the sheet data retrieved From
Const NumRows& = 40 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Sheet3").Range("C3").Resize(40, 27) = Ray 'Change(10,10), to suit columns and rows
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

gimli
03-25-2010, 11:56 AM
Hey thats works great! Thanks much!

One more question...

The test.xls file im importing data from is downloaded from SAP. Before I can use the file to import I need to open and save the file. Something about saving it with a coma deliminated.

Is it possible to insert something into the code to open and save the file before its imported automatically in the backround? just overwriting itself using the same name?

If so that would be awesome..save an anoying step

thanks much for your help

mdmackillop
03-25-2010, 12:08 PM
Looking at your code, I think you just needed to remove this line

Columns.AutoFit

Re your last question, can you state all the steps that you follow. I'm not clear on this.

gimli
03-26-2010, 05:08 AM
mdmack,

Ok...

1. Run Report in SAP. I can download the report as xls, uncoverted or rtf. I choose to save in xls format figuring it would be easier to import.
2. I save the xls as test.xls
3. When I run the separate spread sheet using the macro posted here to import the test.xls data as it was downloaded...most of the fields are populated with #ref!.
4. To get around that...before I import the data...I need to open the test.xls first, then save it over itself.
5. When saving I get this message "text.xls may contain features that are not compatable with text (tab deliminated). do you want to keep this workbook in this format?"
6. I click NO..and save it as text.xls overwriting the original download
7. Then when I run the seperate spreadsheet to import the data it works. All the data loads with no #ref!.

So my question is...can the macro in the seperate spreadsheet used to import data...also be coded to open the test.xls first...then save it selecting option "NO". Either overwrite the original or save as a new name.

Hope that helps..really appreciate the help here

Paul_Hossler
03-26-2010, 05:14 AM
In our SAP instance, when we opt to save as XLS, it's really a XLS in a MIME wrapper.

I suspect that's why you need to save it over itself as a 'real' xls.

Try to use Notepad to open the SAP's "XLS" file and see if you have MIME-type references at the beginning (they should be pretty obvioious)

Paul

gimli
03-26-2010, 05:22 AM
Paul,

When I open it with note pad..its readable..looks space deliminated maybe. When I save it in excel format its garbage when I open it with note pad

gimli
03-26-2010, 09:53 AM
is bumping allowed?

gimli
03-26-2010, 10:25 AM
Ok..heres what I tried but says cant find the file. In bold..just trying to open...save the file and close..


Option Explicit
Sub GetData0()
Workbooks.Open FileName:="test.xls"
Workbooks("test.xls").Close
End Sub

Sub GetDataDemo()
Const Cols = 50 '<== Adjust as required
Dim i As Long
Dim arr(Cols - 1)

'Record column widths
For i = 1 To Cols
arr(i - 1) = Columns(i).ColumnWidth
Next

'Call macro to get data
Call GetMyData

'Reinstate column widths
For i = 1 To Cols
Columns(i).ColumnWidth = arr(i - 1)
Next
End Sub

Private Sub GetMyData()
Dim FilePath$, Row&, Column&, Address$, Ray(1 To 40, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "test.xls" ' Change to suit
Const SheetName$ = "test" ' This is the sheet data retrieved From
Const NumRows& = 40 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Sheet3").Range("C3").Resize(40, 27) = Ray 'Change(10,10), to suit columns and rows
End Sub

Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

mdmackillop
03-26-2010, 12:43 PM
You need to provide the full path name to open a file. Once opened, you handle it using the file name only.

so

Sub GetData0()
Workbooks.Open FileName:="C:\MyLocation\test.xls"
Workbooks("test.xls").Close
End Sub

lucas
03-26-2010, 02:25 PM
gimli, when posting your code please select it and hit the vba button so it will be formatted for the forum. I edited your previous posts in this thread.

gimli
03-29-2010, 05:10 AM
Thanks for all the help so far...almost there.
I highlighted the part in purple...still having problems

Im trying to open the workbook test.xls from the activeworkbook path then close it and when prompted "yes or no" have the macro select no. The below code in purple gives me an error "cant find test.xls".

:banghead:




Sub GetData1()
Dim sPath As String
sPath = ActiveWorkbook.Path
Workbooks.Open ("test.xls")
Workbooks("test.xls").Close

Dim FilePath$, Row&, Column&, Address$, Ray(1 To 75, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "molds.xls" ' Change to suit
Const SheetName$ = "molds" ' This is the sheet data retrieved From
Const NumRows& = 75 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Imported Data").Range("C3").Resize(75, 27) = Ray 'Change(10,10), to suit columns and rows
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

lucas
03-29-2010, 06:35 AM
It finds it and opens it for me if test.xls exists in the same directory as the file with the code.

But why are you opening it and then closing it immediatly?

gimli
03-29-2010, 06:58 AM
Lucas,

Short story is because the test.xls I download from SAP is not a real xls file. Its a file that is space deliminated. So I need to open it and save it as a real xls file. The message I get when I save it is

"text.xls may contain features that are not compatable with text (tab deliminated). do you want to keep this workbook in this format?"

I select no and overwrite the text.xls. Its now in a true excel format and I can then import it with out getting #ref! errors.

I dont know any other way around it. I can also save the document from SAP as HTML but I would know how to import that into excel

gimli
03-29-2010, 07:08 AM
Ok..Lucas this is interesting...

This code only works after I open and save the Test.xls as a true excel file before I run this code. Which is werid...it should work regardless right? Is there a different code that can be used to open test.xls using excel and the save it overitself? Using this code below apparently somehow detects that test.xls is not in excel format thus giving me an error cannot find the file.


Sub GetData1()
Dim sPath As String
sPath = ActiveWorkbook.Path
Workbooks.Open ("test.xls")
Workbooks("test.xls").Close

mdmackillop
03-29-2010, 08:23 AM
Can you post a copy of Test.xls making sure it contains no confidential info.

gimli
03-29-2010, 09:33 AM
Mdmack,

Here is the file. You will notice its not a true excel format file even though its saved by default as an .xls. If you open it with notepad you will see its a space delimited file.

So..I need to open it using excel...and save it so its put into excel formats..then I can import it to my other spreadsheet with a macro.

The only way I can think of doing that is opening in and saving it in the macro if possible.

lucas
03-29-2010, 09:46 AM
If I run this:

Sub GetData1()
Dim sPath As String
sPath = ActiveWorkbook.Path
Workbooks.Open ("test.xls")
' Workbooks("test.xls").Close
End Sub

It opens your test.xls in excel.

gimli
03-29-2010, 10:06 AM
Still says cant find the file...poops out at the open statement.
Both files are in the same directory. The active work book with the macro and the TEST.XLS

If I open the TEST.XLS and save it in excel format, then the macro works.

..:banghead:


Option Explicit

Sub GetData1()
Dim sPath As String
sPath = ActiveWorkbook.Path
Workbooks.Open ("TEST.xls")
' Workbooks("TEST.xls").Close
Dim FilePath$, Row&, Column&, Address$, Ray(1 To 75, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "TEST.xls" ' Change to suit
Const SheetName$ = "TEST" ' This is the sheet data retrieved From
Const NumRows& = 75 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Imported Data").Range("C3").Resize(75, 27) = Ray 'Change(10,10), to suit columns and rows
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

lucas
03-29-2010, 10:11 AM
try this. It is your text.xls.

unzip them both in the same directory and run the runme.xls.

It opens the test.xls for me.

gimli
03-29-2010, 11:03 AM
Nope..doesnt work. I put both files in the same directory and I get this error message..see attached.


My version of excel is 2003 sp3. Wonder if that has anything to do with it

lucas
03-29-2010, 11:07 AM
I have excel 2003 also and it opens it in excel for me.

Maybe try it on a different computer or maybe someone else will verify our results.

mdmackillop
03-29-2010, 11:19 AM
Try

Workbooks.Open (ActiveWorkbook.Path & "\Test.xls")

gimli
03-30-2010, 04:10 AM
Lucas - I did load it on another computer and it still didnt open..werid

MdMack - I used your code suggestion and it worked!

Thanks to both of you for your help...:bow:


Can you also suggest code to -

After the file is open I want to save it and overwrite it with the same name
Will need to answer "no" to the first question and then "yes" to overwrite. The reason for this is so I can save the file in a true excel format. If it can be coded to run in the backround..not seen..that would be cool too.

thanks much

gimli
03-30-2010, 11:37 AM
Ok..forget my last post..how about this

I am trying to open the workbook test.xls (highligted in red) and then importing the data then closing the workbook (highligted in red). I am getting an error at the line highlighted in purple (error 9 subscript out of range). I need to open the workbook so the data transfers correctly..importing it while its closed doesnt work.

if it test.xls can be opened in the backround..so it doesnt show on the screen that would be cool too.

thanks

:bug:


Option Explicit

Sub GetData1()

Dim sPath As String
sPath = ActiveWorkbook.Path
Workbooks.Open (ActiveWorkbook.Path & "\test.xls")

Dim FilePath$, Row&, Column&, Address$, Ray(1 To 225, 1 To 27) ' Change columns and rows to suit
Const FileName$ = "test.xls" ' Change to suit
Const SheetName$ = "test" ' This is the sheet data retrieved From
Const NumRows& = 225 ' Change to suit
Const NumColumns& = 27 'change to suit
FilePath = ActiveWorkbook.Path & "\"
DoEvents
Application.ScreenUpdating = False
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
'Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Ray(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
Next Column
Next Row
ActiveWindow.DisplayZeros = False
Sheets("Imported Data").Range("C3").Resize(225, 27) = Ray 'Change(225, 27), to suit columns and rows
Workbooks("test.xls").Close
End Sub
Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _
Range(Address).Range("A1").Address(, , xlR1C1)
GetData = ExecuteExcel4Macro(Data)
End Function

mdmackillop
03-30-2010, 01:27 PM
When working between workbooks it is best to set variable to represent each, and qualify references to sheets to avoid mix ups


Sub Test()
Dim TgtBk As Workbook
Dim SrceBk As Workbook

Set TgtBk = ThisWorkbook
Set SrceBk = Workbooks.Open(TgtBk.Path & "\test.xls")

' your code
TgtBk.Sheets("Imported Data").Range("C3").Resize(225, 27) = Ray
' and so on

End Sub

gimli
03-31-2010, 04:11 AM
Ok got it...works for me now :clap:

thanks for all the help here.