B
Bishop
I have the following code (it's long but the issue is at the bottom where I
stop):
Option Explicit
Sub Consolidate()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim DCLastRow As Integer 'DirectorCopy
Dim MCLastRow As Integer 'Monthly Compiler
Dim CMonth As String 'Compile Month
Dim CYear As String 'Compile Year
Dim Month As Integer
Dim MonthFilter As String
Dim MCStartRow As Integer 'Monthly Compiler
Dim center(18) As String
center(1) = "Bardstown"
center(2) = "Bothell"
center(3) = "VCollinsville"
center(4) = "El Paso"
center(5) = "Evansville"
center(6) = "Greensboro"
center(7) = "VHeathrow"
center(8) = "Joplin"
center(9) = "Kennesaw"
center(10) = "Lafayette"
center(11) = "Malvern"
center(12) = "VManhattan"
center(13) = "VMansfield"
center(14) = "VOttawa"
center(15) = "VPonco City"
center(16) = "VReno"
center(17) = "VSioux City"
center(18) = "VTerra Haute"
Dim FileCount As Long
Dim ScoringAve As Double
Dim i As Long
Workbooks("Monthly PF Compiler").Activate
' If Cells(13, 4).Value = "January" Then Month = 1
' If Cells(13, 4).Value = "February" Then Month = 2
' If Cells(13, 4).Value = "March" Then Month = 3
' If Cells(13, 4).Value = "April" Then Month = 4
' If Cells(13, 4).Value = "May" Then Month = 5
' If Cells(13, 4).Value = "June" Then Month = 6
' If Cells(13, 4).Value = "July" Then Month = 7
' If Cells(13, 4).Value = "August" Then Month = 8
' If Cells(13, 4).Value = "September" Then Month = 9
' If Cells(13, 4).Value = "October" Then Month = 10
' If Cells(13, 4).Value = "November" Then Month = 11
' If Cells(13, 4).Value = "December" Then Month = 12
' CMonth = MonthName(Month, True)
'This one line of code replaces the above 13 lines
CMonth = Left(Cells(13, 4).Value, 3)
CYear = Right(Cells(13, 7).Value, 2)
'Fill in the path\folder where the files are
MyPath = "X:\C&A Analysts Team\PF Process\1 Tally & PF's Work in
Progress\Centers\"
For i = 1 To 18
' 'Add a slash at the end if the user forget it
' If Right(MyPath, 1) <> "\" Then
' MyPath = MyPath & "\"
' End If
'If there are no Excel files in the folder increment i and continue
MonthFilter = MyPath & center(i) & "\*" & CMonth & " " & CYear &
"*.xl*"
FilesInPath = Dir(MonthFilter)
If FilesInPath = "" Then
MsgBox "No files found in " & center(i)
GoTo ContinueLoop
End If
If FilesInPath <> "" Then
FileCount = FileCount + 1
End If
'Fill the array(myFiles)with the list of Excel files in the folder
'that match the Month and Year selected
Fnum = 0
Do While FilesInPath <> ""
If InStr(1, FilesInPath, CMonth & " " & CYear, vbTextCompare) Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
End If
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Loop through all files in the array(myFiles)
MCStartRow = 1
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & center(i) & "\" &
MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
'Need to do the following:
'if lazy eye hasn't been run in directorcopy then run it
With mybook.Worksheets("DirectorCopy")
If .Cells(1, 1) = "" Then
'Application.Run "DirectorFormat"
Application.Run "'Test Tally
SheetIII.xlsm'!DirectorFormat"
DCLastRow = .Range("A" & Rows.Count).End(xlUp).Row
'Determine how many rows in directorcopy
Else
DCLastRow = .Range("A" & Rows.Count).End(xlUp).Row
End If
mybook.Worksheets("DirectorCopy").Activate
'Copy center,month,week, analyst,uid each to the
first 5 columns in compiler
.Cells(2, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 1))
.Cells(1, 1).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 2))
.Cells(2, 1).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 3))
.Cells(1, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 4))
.Cells(1, 4).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 5))
When I get to:
..Cells(2, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 1))
It gives me "subscript out of range" error. What's confusing is it works
fine for the previous folder. All the spreadsheets are in the same format so
I don't understand why it works for one and not the other. What am I doing
wrong?
stop):
Option Explicit
Sub Consolidate()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook
Dim CalcMode As Long
Dim sh As Worksheet
Dim ErrorYes As Boolean
Dim DCLastRow As Integer 'DirectorCopy
Dim MCLastRow As Integer 'Monthly Compiler
Dim CMonth As String 'Compile Month
Dim CYear As String 'Compile Year
Dim Month As Integer
Dim MonthFilter As String
Dim MCStartRow As Integer 'Monthly Compiler
Dim center(18) As String
center(1) = "Bardstown"
center(2) = "Bothell"
center(3) = "VCollinsville"
center(4) = "El Paso"
center(5) = "Evansville"
center(6) = "Greensboro"
center(7) = "VHeathrow"
center(8) = "Joplin"
center(9) = "Kennesaw"
center(10) = "Lafayette"
center(11) = "Malvern"
center(12) = "VManhattan"
center(13) = "VMansfield"
center(14) = "VOttawa"
center(15) = "VPonco City"
center(16) = "VReno"
center(17) = "VSioux City"
center(18) = "VTerra Haute"
Dim FileCount As Long
Dim ScoringAve As Double
Dim i As Long
Workbooks("Monthly PF Compiler").Activate
' If Cells(13, 4).Value = "January" Then Month = 1
' If Cells(13, 4).Value = "February" Then Month = 2
' If Cells(13, 4).Value = "March" Then Month = 3
' If Cells(13, 4).Value = "April" Then Month = 4
' If Cells(13, 4).Value = "May" Then Month = 5
' If Cells(13, 4).Value = "June" Then Month = 6
' If Cells(13, 4).Value = "July" Then Month = 7
' If Cells(13, 4).Value = "August" Then Month = 8
' If Cells(13, 4).Value = "September" Then Month = 9
' If Cells(13, 4).Value = "October" Then Month = 10
' If Cells(13, 4).Value = "November" Then Month = 11
' If Cells(13, 4).Value = "December" Then Month = 12
' CMonth = MonthName(Month, True)
'This one line of code replaces the above 13 lines
CMonth = Left(Cells(13, 4).Value, 3)
CYear = Right(Cells(13, 7).Value, 2)
'Fill in the path\folder where the files are
MyPath = "X:\C&A Analysts Team\PF Process\1 Tally & PF's Work in
Progress\Centers\"
For i = 1 To 18
' 'Add a slash at the end if the user forget it
' If Right(MyPath, 1) <> "\" Then
' MyPath = MyPath & "\"
' End If
'If there are no Excel files in the folder increment i and continue
MonthFilter = MyPath & center(i) & "\*" & CMonth & " " & CYear &
"*.xl*"
FilesInPath = Dir(MonthFilter)
If FilesInPath = "" Then
MsgBox "No files found in " & center(i)
GoTo ContinueLoop
End If
If FilesInPath <> "" Then
FileCount = FileCount + 1
End If
'Fill the array(myFiles)with the list of Excel files in the folder
'that match the Month and Year selected
Fnum = 0
Do While FilesInPath <> ""
If InStr(1, FilesInPath, CMonth & " " & CYear, vbTextCompare) Then
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
End If
Loop
'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
'Loop through all files in the array(myFiles)
MCStartRow = 1
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & center(i) & "\" &
MyFiles(Fnum))
On Error GoTo 0
If Not mybook Is Nothing Then
'Need to do the following:
'if lazy eye hasn't been run in directorcopy then run it
With mybook.Worksheets("DirectorCopy")
If .Cells(1, 1) = "" Then
'Application.Run "DirectorFormat"
Application.Run "'Test Tally
SheetIII.xlsm'!DirectorFormat"
DCLastRow = .Range("A" & Rows.Count).End(xlUp).Row
'Determine how many rows in directorcopy
Else
DCLastRow = .Range("A" & Rows.Count).End(xlUp).Row
End If
mybook.Worksheets("DirectorCopy").Activate
'Copy center,month,week, analyst,uid each to the
first 5 columns in compiler
.Cells(2, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 1))
.Cells(1, 1).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 2))
.Cells(2, 1).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 3))
.Cells(1, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 4))
.Cells(1, 4).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 5))
When I get to:
..Cells(2, 2).Copy (Workbooks("Monthly PF
Compiler").Worksheets(center(i)).Cells(MCStartRow, 1))
It gives me "subscript out of range" error. What's confusing is it works
fine for the previous folder. All the spreadsheets are in the same format so
I don't understand why it works for one and not the other. What am I doing
wrong?