extract data from closed excel files...(VBA)

[usef]

Hello,

i have a folder which contains lots of excel files. these files are all from the same template. i need to extract all the data out and put them in a table. there is around 20 fileds on each file...

is it possible to extract all these fileds and put them in 1row/20 coluoms? and so on for the rest of the files?? and also have it update for any new files to be added to the table??

TIA

 

[ravishankar]

Hi
it is possible. Can you specify which are these 20 cells (A6 to T6?)
Ravi

 

[usef]

thanks for your kind reply

the ranges are all over the sheet...

a1 a3 a7 a12 a13 a15 d1 d5 g8 g22 h1 r1 w1 t1 y1 aa1 ab1 ab3 ab5 ab7 ab22 ab25 af1 af2 af3 af4 af5 af6 af7 af8 ag1 ag2 ag3 ag4 ag5 ag6

 

[GTO]

Greetings,

Given that the cells are spread about (non-contiguous), while it is possible to grab a cell at a time from a closed wb, it is simpler to simply open it, grab the vals and close.

As you'll see, I shortened the range to make a simpler example, but see if this makes sense:

In a Standard Module:

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br>    <br><SPAN style="color:#00007F">Sub</SPAN> exa()<br><SPAN style="color:#00007F">Dim</SPAN> FSO         <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN> <SPAN style="color:#007F00">'<--- FileSystemObject</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> fsoFolder   <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Object</SPAN> <SPAN style="color:#007F00">'<--- Folder</SPAN><br><SPAN style="color:#00007F">Dim</SPAN> fsoFile     <SPAN style="color:#00007F">As</SPAN> Object <SPAN style="color:#007F00">'<--- File</SPAN><br>    <br>Dim _<br>wbChild         <SPAN style="color:#00007F">As</SPAN> Workbook, _<br>wksChild        <SPAN style="color:#00007F">As</SPAN> Worksheet, _<br>rngChild        <SPAN style="color:#00007F">As</SPAN> Range, _<br>rngChildCell    <SPAN style="color:#00007F">As</SPAN> Range, _<br>aryVals         <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>, _<br>i               <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <br>    <SPAN style="color:#00007F">Set</SPAN> FSO = CreateObject("Scripting.FileSystemObject")<br>    <br>    <SPAN style="color:#00007F">With</SPAN> FSO<br>        <SPAN style="color:#007F00">'// Set a reference to the folder containing the workbooks.  I simply palced    //</SPAN><br>        <SPAN style="color:#007F00">'// several wb's in the same folder as the wb with the code.                    /</SPAN><br>        <SPAN style="color:#00007F">Set</SPAN> fsoFolder = .GetFolder(ThisWorkbook.Path & Application.PathSeparator)<br>        <br>        <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> fsoFile <SPAN style="color:#00007F">In</SPAN> fsoFolder.Files<br>            <br>            <SPAN style="color:#00007F">If</SPAN> fsoFile.Type = "Microsoft Excel Worksheet" _<br>            And <SPAN style="color:#00007F">Not</SPAN> fsoFile.Path = ThisWorkbook.FullName <SPAN style="color:#00007F">Then</SPAN><br>                <br>                <SPAN style="color:#007F00">'// Set references to the opening wb, the correct sheet within, and the //</SPAN><br>                <SPAN style="color:#007F00">'// range..                                                             //</SPAN><br>                <SPAN style="color:#00007F">Set</SPAN> wbChild = Workbooks.Open(Filename:=fsoFile.Path, ReadOnly:=True)<br>                <SPAN style="color:#00007F">Set</SPAN> wksChild = wbChild.Worksheets("Sheet1")<br>                <SPAN style="color:#00007F">Set</SPAN> rngChild = wksChild.Range("a1,a3,a7,a12,a13,a15,d1,d5,g8,g22,h1")<br>                <br>                <SPAN style="color:#007F00">'// size the array based upon the number of cells we are snagging.      //</SPAN><br>                <SPAN style="color:#00007F">ReDim</SPAN> aryVals(1 <SPAN style="color:#00007F">To</SPAN> 1, 1 <SPAN style="color:#00007F">To</SPAN> rngChild.Cells.Count)<br>                <br>                <SPAN style="color:#007F00">'// plunk the vals into the array                                       //</SPAN><br>                i = 0<br>                <SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> rngChildCell <SPAN style="color:#00007F">In</SPAN> rngChild<br>                    i = i + 1<br>                    aryVals(1, i) = rngChildCell.Value<br>                <SPAN style="color:#00007F">Next</SPAN><br>                <br>                <SPAN style="color:#007F00">'// Pick the first empty row and resize the range to fit the array. //</SPAN><br>                <SPAN style="color:#007F00">'// Not tested, but should fail if any A1 cells in child wb's are   //</SPAN><br>                <SPAN style="color:#007F00">'// empty.  YOu may wish to find first available row by .Find instead//</SPAN><br>                ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp) _<br>                    .Offset(1).Resize(, rngChild.Cells.Count).Value = aryVals<br>                <br>                <SPAN style="color:#007F00">'// close/no save                                                   //</SPAN><br>                wbChild.Close <SPAN style="color:#00007F">False</SPAN><br>                <br>            <br>            <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN><br>        <SPAN style="color:#00007F">Next</SPAN><br><br>        <br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN></FONT>

Hope that helps,

Mark

 

[ravishankar]

Hi
Assuming the sheet name is sheet1 ( and not using xl 2007) ,save a workbook with the following codes inside the folder from which you wish to pull data. run the macro

Sub Usef()
Dim e As Long, g As Long
Dim f As String, h As String
Cells(1, 1) = "=cell(""filename"")"
Cells(1, 2) = "=left(A1,find(""["",A1)-1)"
Cells(2, 1).Select
f = Dir(Cells(1, 2) & "*.xls")
    Do While Len(f) > 0
    ActiveCell.Formula = f
    ActiveCell.Offset(1, 0).Select
    f = Dir()
    Loop
    For e = 3 To Range("A65536").End(xlUp).Row
    If Cells(e, 1) <> ActiveWorkbook.Name Then
        For g = 1 To 36
        h = Choose(g, "a1", "a3", "a7", "a12", "a13", "a15", "d1", "d5", "g8", "g22", "h1", "r1", "w1", "t1", "y1", "aa1", "ab1", "ab3", "ab5", "ab7", "ab22", "ab25", "af1", "af2", "af3", "af4", "af5", "af6", "af7", "af8", "ag1", "ag2", "ag3", "ag4", "ag5", "ag6")
        Cells(2, g + 1) = h
        Cells(1, 3) = "='" & Cells(1, 2) & "[" & Cells(e, 1) & "]Sheet1'!" & h
        Cells(e, g + 1) = Cells(1, 3)
        Next g
        End If
    Next e
MsgBox "collating is complete."
End Sub

It lists filenames in col A and data from Col B to AK
ravi

 

[usef]

thanks for both of you!!! :D they both work but i will stick with ravishankar code bcz it dosnt open anyfiles... but is there any way we could speed up the the macro bcz its kind of slow?

 

[usef]

dear ravishankar,
i am using your code and it works very good! is it possible that when i run it again have it continue from where it ended the last time just so it can do it faster... and have an option whether to update the entier thing?