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
Bookmarks