Thanks Thanks:  0
Likes Likes:  0
Page 2 of 2 FirstFirst 12
Results 11 to 17 of 17

Thread: Extracting data from multiple workbooks.

  1. #11
    Board Regular
    Join Date
    Mar 2002
    Location
    England, UK.
    Posts
    526
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    I wish you luck.

    It would be cool if you could let us know how long that takes you. I am obsessed with the speed of stuff nowadays (sigh)

    RET79

  2. #12
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Try this routine;
    Notes:

    1) Not fully tested.
    2) Assumes sheet name = Sheet1
    3) Change Dirs as required.


    Option Base 1

    Sub GetValueFromClosedFile_ViaFormula()
    Dim sDir As String
    Dim ShtCellLoc(3) As String
    Dim DataRg As Range
    Dim Files
    Dim x As Double
    '/////////////////////////////////////////////////////////////////
    '// Info: /
    '// Files :"P046000.xls" to "P057999.xls". /
    '// /
    '// Cells to extract information from: "C2, I57, I58". /
    '// /
    '// Info to be copied to A2, B2, C2 and so on for 12000 rows, /
    '// keeping the 3 columns common. /
    '/////////////////////////////////////////////////////////////////

    '// This is the Dir to search in
    sDir = "C:analysis"

    '// This is the Location/cell address
    ShtCellLoc(1) = "Sheet1'!$C$2"
    ShtCellLoc(2) = "Sheet1'!$I$57"
    ShtCellLoc(3) = "Sheet1'!$I$58"

    Files = Dir(sDir & "*.xls")

    '// Clear area Column A to place data in
    Columns("A:C").Clear

    'speed things up
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    x = 2
    On Error GoTo FileError
    Do While Len(Files) > 0
    Cells(x, 1) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(1)
    Cells(x, 2) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(2)
    Cells(x, 3) = "='" & sDir & "[" & Files & "]" & ShtCellLoc(3)
    x = x + 1
    Files = Dir()
    Loop

    '// calculate NOW!!
    Application.Calculate

    Set DataRg = Range(Range("A2:C2"), Range("A2:C2").End(xlDown))
    DataRg.Copy
    DataRg.PasteSpecial Paste:=xlValues
    Columns("A:C").Columns.EntireColumn.AutoFit
    Application.CutCopyMode = False

    Set DataRg = Nothing

    Application.Calculation = xlCalculationAutomatic
    Application.Calculate
    Application.ScreenUpdating = True

    MsgBox "Done!...updating complete", vbInformation + vbSystemModal, "Update Status" '64+4096

    Exit Sub
    FileError:
    MsgBox Err.Number & Chr(13) & _
    Err.Description & Chr(13) _
    , vbCritical + vbMsgBoxHelpButton, _
    "File Error", _
    Err.HelpFile, _
    Err.HelpContext
    End Sub




    _________________
    Kind Regards,
    Ivan F Moala
    http://www.gwds.co.nz/excel_files.html - Under Constru

    [ This Message was edited by: Ivan F Moala on 2002-04-27 17:02 ]

  3. #13
    MrExcel MVP Tom Urtis's Avatar
    Join Date
    Feb 2002
    Location
    San Francisco, California USA
    Posts
    11,162
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hey Ivan, this is great...it looks like the basis of your code (aside from reaching all the files in a directory) is a paste link formula in a macro, and PSVing over the formula.

    For Jack: you can probably see at least three benefits from Ivan's code --
    It bypasses the need for the file to be opened,
    It thereby bypasses the prompt to update links,
    And the destination cell(s) end(s) up with a value instead of a formula to keep the file size down.

    Ivan -- Still working on my web site, mostly because I have a backlog (can't believe it myself !) of Excel projects. Hopefully California's economy is out of the doldrums.

    Thanks to all on this thread.

  4. #14
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-04-27 18:18, Tom Urtis wrote:
    Hey Ivan, this is great...it looks like the basis of your code (aside from reaching all the files in a directory) is a paste link formula in a macro, and PSVing over the formula.

    For Jack: you can probably see at least three benefits from Ivan's code --
    It bypasses the need for the file to be opened,
    It thereby bypasses the prompt to update links,
    And the destination cell(s) end(s) up with a value instead of a formula to keep the file size down.

    Ivan -- Still working on my web site, mostly because I have a backlog (can't believe it myself !) of Excel projects. Hopefully California's economy is out of the doldrums.

    Thanks to all on this thread.
    Tom thats exactly it.
    Let us know when the site is finished.
    I'm still a long way off getting my site up.
    My assoiate has his side of it done.....
    Web page designing, I'm trying to compliment
    his side of it with Excel.

    All the best
    Kind Regards,
    Ivan F Moala From the City of Sails

  5. #15
    New Member
    Join Date
    Apr 2002
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Hey Ivan,

    That's great man. I will put it to test right away. Just want some update on these codes. They look like working, but i face some problem. The PC hangs the moment i run this code. Might be interferin gwith something. Just let me know on them.

    Thankx.
    Jack

    I can select the particulsr cell from the closed workbook. But i face two problems.

    1. I cant' paste them in the new workbook and

    2. I cant' loop the files from P046000 to P057999

    -------------------------
    Sub hastowork()
    Dim XL As Excel.Application
    Dim WBK As Excel.Workbook
    Set XL = CreateObject("Excel.Application")
    Set WBK = XL.Workbooks.Open("C:AssignP046001.xls")
    WBK.Sheets("pg46.vts").Range("C2").Select
    Selection.Copy
    WBK.Close
    Sheets("sheet1").Select
    Range("B1").Select
    ActiveSheet.Paste
    End Sub
    ---------------

  6. #16
    New Member
    Join Date
    Apr 2002
    Posts
    6
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    No luck yet guys. The macro simply refuses to work. try whatever i may. Help!!!

    Jack

  7. #17
    MrExcel MVP Ivan F Moala's Avatar
    Join Date
    Feb 2002
    Location
    Auckland, New Zealand
    Posts
    4,209
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    On 2002-04-29 18:40, cabala wrote:
    No luck yet guys. The macro simply refuses to work. try whatever i may. Help!!!

    Jack
    Jack which macro code refuses to run and
    what code is it hanging on....
    Kind Regards,
    Ivan F Moala From the City of Sails

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •