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?

My best guess would be that your worksheet
Worksheets(center(i))
does not exits in the target workbook... Look for blank characters,
misspellings or such in the tab names.

FYI you should change all of your integer declarations to long. The number
of rows can easily exceed the limit for an integer. Additionally there is no
advantage to using an intger in VB. Integers are 16 bit but your machine is
32 bit. Intgers actually require more processing than longs...
--
HTH...

Jim Thomlinson


"Bishop" wrote:

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?

This is why I come here. You guys are dead on. I mispelled the worksheet
name.

Thanks!

"Jim Thomlinson" wrote:

My best guess would be that your worksheet
Worksheets(center(i))
does not exits in the target workbook... Look for blank characters,
misspellings or such in the tab names.

FYI you should change all of your integer declarations to long. The number
of rows can easily exceed the limit for an integer. Additionally there is no
advantage to using an intger in VB. Integers are 16 bit but your machine is
32 bit. Intgers actually require more processing than longs...
--
HTH...

Jim Thomlinson


"Bishop" wrote:

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?