Sub LoopAllFilesGetMTL_v2()
' Declaration section 'RB: moved inside the procedure to "limit the scope" of the variables.
Dim WorkBk As Workbook
Dim wks As Worksheet
Dim SummarySheet As Worksheet
Dim FirstBlankCll As Range 'RB: given a more meaningful name than... 'Dim c As Range
Dim Filename As String
Dim FolderPath As String
Dim SelectedFiles As Variant
Dim NFile As Variant
Dim NRow As Long
Dim SummarySheetLastRow As Long
Dim strSheetName As String
Dim arr As Variant
Dim i As Long
Dim FName As String
Dim targetWS As Worksheet
Dim nextAvlbleCllInColA As Range
'
'Setup
With Application
.ScreenUpdating = False 'speed up macro execution
.EnableEvents = False 'turn off other macros for now
.displayAlerts = False 'turn off system messages for now
End With
'Next line is bad since it will prevent any errors from being seen
'On Error Resume Next ' recommend commenting it out
' Create a new workbook and set a variable to the first sheet & the target worksheet.
With ThisWorkbook
Set SummarySheet = .Sheets("WBS_MTL")
Set targetWS = .Worksheets("WBS_Hours")
End With
SummarySheet.Select
' Modify this folder path to point to the files you want to use.
FolderPath = "N:\Proposals\FY2007\P0756 NG\PROPOSAL FILES\SUBMITTALS\Rev S2 - Discount Submitted\"
' FolderPath = ThisWorkbook.path
' Set the current directory to the the folder path.
ChDrive FolderPath
ChDir FolderPath
' Open the file dialog box and filter on Excel files, allowing multiple Files
' to be selected.
SelectedFiles = Application.GetOpenFilename( _
filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)
If IsArray(SelectedFiles) Then
' NRow keeps track of where to insert new rows in the destination workbook.
NRow = 3 'starting number of row where the data is to be copied.
With ThisWorkbook.Worksheets("WBS_Hours")
.Rows("2:" & .Rows.Count).Delete
End With
'If you want to start with a blank summary sheet, uncomment the next paragraph
With SummarySheet
'Clear all rows below the column header
SummarySheetLastRow = .Cells(.Rows.Count, 3).End(xlUp).Row
If SummarySheetLastRow > 2 Then
.Range("A2:A" & SummarySheetLastRow).EntireRow.Delete
End If
End With
' Loop through the list of returned file names
For NFile = LBound(SelectedFiles) To UBound(SelectedFiles) ' ---FIRST LOOP START ---+
' Set FileName to be the current workbook file name to open.
Filename = SelectedFiles(NFile)
FName = Mid(Filename, InStrRev(Filename, "\") + 1, 999)
' Open the next workbook that was selected in the dialog box
Set WorkBk = Workbooks.Open(Filename) 'newly opened workbook is Active Workbook
' Search for specified format Worksheet's Name
For Each wks In WorkBk.Worksheets ' --- SECOND LOOP START---+
strSheetName = wks.Name
' Check if Sheet Name format match criteria
If Len(strSheetName) <> 6 Then GoTo LabNextSheet
arr = Split(strSheetName, ".")
If UBound(arr) <> 1 Then GoTo LabNextSheet
If Not IsNumeric(arr(0)) Then GoTo LabNextSheet
If Not IsNumeric(arr(1)) Then GoTo LabNextSheet
If Not Len(arr(0)) = 2 Then GoTo LabNextSheet
Application.StatusBar = _
"Processing '" & NFile & "' - '" & strSheetName
'Complete WBS_MTL worksheet
With ThisWorkbook.Worksheets("WBS_MTL")
Set FirstBlankCll = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0)
End With
With FirstBlankCll.Resize(5, 1)
'Column A - Filename
.Offset(0, 0).Value = FName
'Column B - WBS Number
.Offset(0, 2).Formula = "=HYPERLINK(""" & Filename & "#" & strSheetName & "!N8"",""" & strSheetName & """" & ")"
'Column D - Assembly
.Offset(0, 3).Value = wks.Range("I10").Value
'Column E - Operation Description
.Offset(0, 4).Value = wks.Range("H11").Value
'Column G - Description
.Offset(0, 6).Value = wks.Range("B15:b19").Value
'Column H - UM (each or lot)
.Offset(0, 7).Value = wks.Range("C15:c19").Value
'Column I - Qty
.Offset(0, 8).Value = wks.Range("D15:d19").Value
'Column J - Cost Each
.Offset(0, 9).Value = wks.Range("E15:e19").Value
'Column K - Total
.Offset(0, 10).Value = wks.Range("R15:r19").Value
End With
'GET HOURS FROM EACH FILE
With targetWS
If IsEmpty(.Range("C2")) Then
Set nextAvlbleCllInColA = .Range("a2")
Else
'### Is column C always populated for every row?
'(if not, we should use a different approach to identifying the next row)
Set nextAvlbleCllInColA = .Cells(.Range("C1").End(xlDown).Row + 1, "a")
End If
End With
With wks.Range("F23:Q38")
'###RB: is this what you want for columns A & B?
nextAvlbleCllInColA.Resize(.Rows.Count, 1).Value2 = FName
nextAvlbleCllInColA.Offset(0, 1).Resize(.Rows.Count, 1).Value2 = wks.Name
'put the column E value into column C
nextAvlbleCllInColA.Offset(0, 2).Resize(.Rows.Count, 1).Value2 = .Offset(0, -1).Resize(.Rows.Count, 1).Value2
'to choose the correct column to copy the data into, add 3 to the value of cell F22.
nextAvlbleCllInColA.Offset(0, wks.Range("F22").Value2 + 2).Resize(.Rows.Count, .Columns.Count).Value2 = .Value2
End With
' Go on to the next loop
LabNextSheet:
Next wks ' --- SECOND LOOP END ---+
WorkBk.Close savechanges:=False
Next NFile ' --- FIRST LOOP END ---+
'RB: moved out of the loop because it only needs to be done once.
SummarySheet.Columns.AutoFit
End If
delete_Blank_Rows
'Reset app. settings
With Application
.StatusBar = False
.ScreenUpdating = True
.displayAlerts = False
.EnableEvents = True
End With
End Sub
