Importing into Excel with a twist

[Jimuniguy]

Hello,

Background:
Every day i have an instrument which measures some chemicals and outputs them into an excel spreadsheet nicely.

What I want:
I need to take some selected cells (always constantly the same ones) and import them into a spreadsheet so that they reamin permantly in that spreadsheet.

Problem:
The filename is unique each day (sequantial to be precise) and i need to delete the file when the cells have been imported and for the data to remain intact in the orginal spreadsheet. I want this as a macro.

Any ideas?

Jimuni

 

[globalbear]

I had a similar problem recently.

First - put the copy-from-spreadsheet in an empty catalog. Then open whatever-excel-file-there-is in that catalog. This code works for this:

MyPath = "C:\whatever"

With Application.FileSearch
.LookIn = MyPath
.Filename = "*.xls"
.Execute
End With

With Application.FileSearch

For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Myfile = Application.ActiveWorkbook.Name
Next i

End With

Then copy your cells to the new spreadsheet:

Range(MyRange).Copy
Workbooks("NewSpreadSheet.xls").Activate
Sheets("MySheet").Range("NewRange").Select
Cells.PasteSpecial

You might want to change NewRange every day in order not to copy to the same cells every day...

Last, close the copy-from-spreadsheet:

Workbooks(Myfile).Close

I haven't figured out how to delete the old file - but I'm sure there is a way...

//globalbear

 

[Jimuniguy]

Hello,

Wow this is just the ticket (i think!)

Few questions:

A) When you say catalog, do you mean folder?
B) Range of cells to be copied. The range stays the same that i need to copy out each day, say A2, B16 and C13. Each needs to go into the main spreadsheet as a new column or row, i don't mind which.
C) When copying into the new spreadsheet, in the above, what is the new spreadsheet name? This will be the same spreadsheet every day its copied into

Thanks for taking the time to lay it out like you did above, it really helps me understand it!

Jim

 

[globalbear]

A) Yes I mean folder (I normally speak Swedish...)

B)Define MyRange like this:

Dim MyRange As Variant
MyRange = "A2,B16,C13"

A2,B16 means cells A2 AND B16
A2:B16 means ALL cells between A2 and B16

Do the same with NewRange

C) Replace "NewSpreadSheet.xls" above with the name of your spreadsheet. Also replace "MySheet" with the name of the sheet you want to copy into.

 

[Jimuniguy]

Hello,

I seem to be having a few problems

1) The above ranges are not allowed, as "multiple selections are not allowed" This is really annoying to be honest, anyway to get around it?

2) When doing the above, the entire spreadsheet that i am importing into gets filled up and the macro runs around in a cirlce causing excel to crash.

Any reasons why?

The below is my current macro.
------------------------------
Sub ImportstandardMacro()
'
' ImportstandardMacro Macro
' Keyboard Shortcut: Ctrl+a
'

MyPath = "C:\temp\import\"

With Application.FileSearch
.LookIn = MyPath
.Filename = "*.xls"
.Execute
End With

With Application.FileSearch

For i = 1 To .FoundFiles.Count
Workbooks.Open Filename:=.FoundFiles(i)
Myfile = Application.ActiveWorkbook.Name
Next i

End With

Dim MyRange As Variant
MyRange = "F8,F10"

Dim NewRange As Variant
NewRange = "A1,A2"

Range(MyRange).Copy
Workbooks("Standards.xls").Activate
Sheets("Imports").Range(NewRange).Select
Cells.PasteSpecial
Workbooks("3603.xls").Close

End Sub
-------------------------

Thank
you

 

[VBAjedi]

AFAIK, there is no way to copy a multiple-selection range. It generates an error, even if you try to do it manually in Excel. So just do two copy operations, one for each cell.

By the way, the command to delete a file is "Kill " followed by the complete pathname of the file. For example, the following little function deletes all .xls files in a given directory:

Function funDeleteAllXLS(strFilePath As String)
  Dim strFolderItems As String
     strFolderItems = Dir(strFilePath & "*.xls")
     Do While strFolderItems <> ""
         Kill (strFilePath & strFolderItems)
         strFolderItems = Dir
     Loop
End Function

You could simply call this function (after you perform the copy and close the source file) just in case more than one .xls files ended up in the directory.


VBAjedi

 

[pbrodsky]

or something like ...

sub standardimport
outputfile="thisfile.xls"
outputrow=cells(65535,1).end(xlup).row + 1
datadir=" (whatever folder data files are in) "
inputfile=dir(datadir & "\*.xls")\
do until inputfile=""
workbooks(inputfile).open
windows(inputfile).activeworksheet.cells(outputrow,"a")=cells(8,"f") 'note: cells uses (row,col)
windows(inputfile).activeworksheet.cells(outputrow,"b")=cells(8,"g") ' or whatever
'continue like this for each cell you want to import
workbooks(inputfile).close false
kill(inputfile)
outputrow=outputrow + 1
fn = dir ' get next input file or "" if no more files
loop
end sub


This of kind of off the cuff - haven't tested it so ther may be some details that need to be changed eg. you might have to do a chgdir(...) to the directory you are using for input, and there might be some typos, but something like this should work.