PDA

View Full Version : Import Data Help



gimli
03-23-2010, 10:07 AM
Hi all,

Looking for some help with importing data from a file. I found some code that works posted below. Is there a way to specify what sheet the data gets imported too? And also a starting point to populate the data?

Ex:

Import data from test.xls and populate in sheet 3 starting at A4? Right now it just populates the sheet that is open when I run the macro. I have a macro button on sheet 1 and I want it to populate on sheet 3 starting at cell A4.

Thanks in advance




Sub GetData()
Dim FilePath$, Row&, Column&, Address$

'change constants & FilePath below to suit
'***************************************
Const FileName$ = "test.xls"
Const SheetName$ = "sheet 1"
Const NumRows& = 25
Const NumColumns& = 27
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)
Columns.AutoFit
Next Column
Next Row
ActiveWindow.DisplayZeros = False
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


Edit: VBA tags added to code

mdmackillop
03-23-2010, 10:31 AM
Untested

Sub GetData()
Dim FilePath$, Row&, Column&, Address$

'change constants & FilePath below to suit
'***************************************
Const FileName$ = "test.xls"
Const SheetName$ = "sheet 1"
Const NumRows& = 25
Const NumColumns& = 27
FilePath = ActiveWorkbook.Path & "\"
'***************************************

DoEvents
Application.ScreenUpdating = False
With Sheets(3)
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
.Range("A4").Offset(Row - 1, Column - 1) = GetData(FilePath, FileName, SheetName, Address)
.Columns.AutoFit
Next Column
Next Row
End With
ActiveWindow.DisplayZeros = False
End Sub

lucas
03-23-2010, 10:34 AM
Welcome to the board

Replace this line:
Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)
With this:
Sheets("Sheet3").Cells(Row, Column) = GetData(FilePath, FileName, SheetName, Address)

I also noticed that your sub and function have the same name. You should rename the sub not the function.

gimli
03-23-2010, 10:48 AM
Thanks for the quick replys..

Lucas...I changed the code as you suggested...works fine with the exception that all blank cells are imported and populated with a zero.

any way to fix that?

lucas
03-23-2010, 10:54 AM
Malcolms code works perfectly.

edit: I see what you mean......

lucas
03-23-2010, 11:49 AM
You have to activate sheet 3 it seems.

Add this line:

Sheets(3).Activate

just above:
ActiveWindow.DisplayZeros = False

lucas
03-23-2010, 12:17 PM
Sub GetDataDemo()
Dim FilePath$, Row&, Column&, Address$

'change constants & FilePath below to suit
'***************************************
Const FileName$ = "test.xls"
Const SheetName$ = "sheet 1"
Const NumRows& = 25
Const NumColumns& = 27
FilePath = ActiveWorkbook.Path & "\"

'***************************************

DoEvents
Application.ScreenUpdating = False
With Sheets(3)
If Dir(FilePath & FileName) = Empty Then
MsgBox "The file " & FileName & " was not found", , "File Doesn't Exist"
Exit Sub
End If
'change the 1 in the NumRows and NumColumns to detemine where to import to.
For Row = 1 To NumRows
For Column = 1 To NumColumns
Address = Cells(Row, Column).Address
.Range("A4").Offset(Row - 1, Column - 1) = GetData(FilePath, FileName, SheetName, Address)
Columns.AutoFit
Next Column
Next Row
Sheets(3).Activate
ActiveWindow.DisplayZeros = False
End With
Sheets(1).Activate
Application.ScreenUpdating = True
End Sub

GTO
03-23-2010, 12:25 PM
Cross-posted: http://www.mrexcel.com/forum/showthread.php?t=456843

gimli,

You may wish to read: Here (http://excelguru.ca/node/7)

gimli
03-24-2010, 07:06 AM
Hrmm

didnt know it would be an issue posting on a different forum.

Oh well