+ Reply to Thread
Results 1 to 8 of 8

Get data from several closed xls files

Hybrid View

  1. #1
    Registered User
    Join Date
    02-12-2007
    Location
    Downham, Bromley, Kent, UK
    Posts
    4

    There must be a better way?

    GlenUK: Sorry mate, I was just expecting to get a few suggestions on how to tackle the problem but please find the code I have cobbled together below. I have moved on a little since I last posted. I have managed to get the macro to:
    1. Count the number of Excel files in the "Regions" folder (The number will change from week to week)
    2. List the Excel file names in the "Files" worksheet (in the "Metrics" workbook).
    3. Create a new worksheet for every Excel file found in "Regions" folder and named accordingly.
    4. Get the values from 100 cells (however I would like all values from populated cells in column 1) in column 1 from the closed workbooks in the "Regions" folder and written into the respective worksheets in the "Metrics" workbook.

    The values that I am collecting from the Regions workbooks are record reference codes (ie. BBRY7010 or ADBE7922,etc). At some point I will need the macro to read a ref code from the new worksheets, look for it in a "Master" workbook and pull out its status from a "Status" column in the "Master". Finally I need the macro to produce a summary of the number of ref codes for a particular region which are of a particular status ie How many of Russia's Ref codes are at status "Production Ready", how many are in "UAT", etc (there are 6 different status's).

    If you can stand to read anymore here follows an explanation of what I have walked into. The small team I have just joined have been struggling with this mess of workbooks for over a year now. The "Macro/Formula" guy left the week before I started. The Deputy has to produce a report once a week. This involves copying vlookup formulas and Index/Match formulas (they haven't even decided to use one or the other) into at least 12 columns of each "Regions" workbooks and manually copying (by dragging) them down each column through between 200 to 2500 records. Having copied all these formulae into the thousands of cells in the different regions workbooks this then produces the correct figures (using VLookup or Index/Match formulae) for a summary table on a "Summaries" sheet in each region's workbook. The Deputy then manually copies and pastes values from each region's "Summary" worksheet into respective pre-prepared tables on a "Summaries" workbook. You can imagine how long this takes considering he has to wait for each of the 49 workbooks to open before he conducts his little formulae copying exercise. To make matters worse 2 of the team (the Leader and the Deputy) are on a Citrix thin client using Vista and Office2007 while I and the other 3 are on the outgoing system which is XP with Office2003. The Citrix system is awfully slow. The Deputy has to produce these summary reports every week and doesnt finish till 9 or 10pm due to the combined issues described above.

    I know this is all a bit long winded but I need to do this Excel/VBA macro stuff as a firefighting measure first. When I get this done it will buy me the time to get the whole sorry mess into an Access database.

    Any help or advise (other than "Run away!") would be much appreciated.

    ====================The code===============================

    Const strMetrics = "\\.server.\.path.\DevArea\Metrics.xls"
    Const strReportsPath = "\\.server.\.path.\DevArea\Regions\"

    Dim strFileName As String
    Dim FileCount As Integer

    Sub Summaries()
    '=========================================================
    '
    ' Summaries Macro
    ' Macro recorded 24/06/2008 by Mark
    '=========================================================

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Call GetFileNames ' Looks in Regions folder for excel files and writes the file names into rows in the Files sheet.

    Call PopRegionTables

    '?????????????????????????????????????????????
    '
    ' The rest of the code goes here
    '
    '?????????????????????????????????????????????

    MsgBox "Data population of Summary reports is complete"

    End Sub

    Function GetFileNames()

    Dim p As String, x As Variant

    p = strReportsPath
    x = GetFileList(p)

    Select Case IsArray(x)
    Case True 'files found
    'MsgBox UBound(x) & " files found in Regions folder"
    Sheets("Files").Range("A:A").Clear
    For i = LBound(x) To UBound(x)
    Sheets("Files").Cells(i, 1).Value = x(i)
    Next i
    Case False 'no files found
    MsgBox "No matching files"
    End Select

    End Function

    Function GetFileList(FileSpec As String) As Variant
    ' Returns an array of filenames that match FileSpec
    ' If no matching files are found, it returns False

    Dim FileArray() As Variant
    'Dim FileCount As Integer
    Dim FileName As String

    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound

    ' Loop until no more matching files are found
    Do While FileName <> ""
    FileCount = FileCount + 1
    ReDim Preserve FileArray(1 To FileCount)
    FileArray(FileCount) = FileName
    FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function
    ' Error handler
    NoFilesFound:
    GetFileList = False
    End Function
    Function PopRegionTables()

    Dim NewWks As Worksheet
    Dim NewName As String

    For i = 1 To FileCount

    Set NewWks = Worksheets.Add
    strFileName = Worksheets("Files").Cells(i, 1).Value
    NewName = Trim(strFileName)
    NewWks.Name = NewName

    Call GetValueFmClosed 'from closed file strFileName into Sheet strFileName

    Next i

    End Function
    Function GetValueFmClosed()

    p = strReportsPath
    f = strFileName
    s = "App List"

    Application.ScreenUpdating = False

    For r = 2 To 100
    'For c = 2 To 3
    a = Cells(r, 2).Address
    Cells(1, 1) = "Wrap ID"
    Range("A1").Select
    With Selection.Interior
    .ColorIndex = 6
    .Pattern = xlSolid
    End With
    Columns("A:A").EntireColumn.AutoFit
    Cells(r, 1) = GetValue(p, f, s, a)
    'Next c
    Next r

    Application.ScreenUpdating = True

    End Function

    Function GetValue(path, file, sheet, ref)
    '======================
    '\\ John Walkenbach
    '\\ http://www.j-walk.com/ss/excel/tips/tip82.htm
    '\\ Retrieves a value from a closed workbook
    '======================
    Dim arg As String

    ' Make sure the file exists
    If Right(path, 1) <> "\" Then path = path & "\"
    If Dir(path & file) = "" Then
    GetValue = "File Not Found"
    Exit Function
    End If

    ' Create the argument
    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
    Range(ref).Range("A1").Address(, , xlR1C1)

    ' Execute an XLM macro
    GetValue = ExecuteExcel4Macro(arg)
    End Function

  2. #2
    Forum Expert shg's Avatar
    Join Date
    06-20-2007
    Location
    The Great State of Texas
    MS-Off Ver
    2010, 2019
    Posts
    40,689
    OC0nn0r,

    Please read the Forum Rules and then wrap your code with Code Tags.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

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

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1