Below is the VBA code I am using to separate my master audit sheet into new sheets based upon a date criteria staring in row 9 column a. Everything about this macro works correctly accept I can't get the macro to separate the new sheets by the correct date criteria. My master sheet will consist of several pay periods dates in column a starting at row 9 and going down. I want the dates and rows to be separated by school year. For example my audit may be for 3 school years first the 2006/2007 school year then 2007/2008 and then 2008/2009. On my master audit sheet I have all the pay periods dates starting from Jan 1, 2006 in row 9 columns A and then a new pay period date in the next row until the end of the audit. I want to break this down to new sheets by school year. If this worked correctly the first sheet would go from Jan 1, 2006 to the last pay period before Aug, 1, 2006, the next sheet would go from the first pay period in Aug 2006 through the last pay period before Aug 2007, the next sheet would go from the first Pay period in Aug 2007 to the last pay period before Aug 2008, and the next sheet would go from the first pay period in Aug 2008 until the last pay period before Aug 2009. How can I add to correct code separated the rows by the date criteria I want in Column a starting at row?


Sub CopyRowsByDate()

Dim startRange As Range
Dim currentRange As Range
Dim currentRow As Long
Dim nextRow As Long
Dim currentFY As Integer
Dim prevFY As Integer
Dim RangesToCopy() As Range
Dim RangeNames() As String
Dim idx As Integer

idx = 0


'Setup the start range, always Row 9
currentRow = 9
Set startRange = Range("A" & currentRow)
Set currentRange = startRange
prevFY = GetSchoolFiscalYear(currentRange)
currentRow = currentRow + 1


Do
'Set nextRow to the row below the one we are currently evaluating
nextRow = currentRow + 1
'Check to see if the cell in column A is empty, if it is that means the current row
If currentRange.Value <> 0 Then
currentFY = GetSchoolFiscalYear(currentRange)
If prevFY <> currentFY Then
ReDim Preserve RangesToCopy(0 To idx)
ReDim Preserve RangeNames(0 To idx)
Set RangesToCopy(idx) = Range(startRange, Range("AB" & (currentRow - 1)))
RangeNames(idx) = prevFY
Set startRange = currentRange
prevFY = currentFY
idx = idx + 1
End If
End If
Set currentRange = Range("A" & nextRow)
currentRow = nextRow
Loop Until currentRange.Value = "TOTALS"

CreateNewSheets RangeNames, RangesToCopy

End Sub

Sub CreateNewSheets(RangeNames() As String, RangesToCopy() As Range)
Dim sheetName As String
Dim sheetPrefix As String
Dim startFy As String
Dim endFy As String
Dim baseRange As Range
Dim i As Integer
Dim newWorkSheet As Worksheet
Set baseRange = Range("A1:AB8")
sheetPrefix = "KD"
For i = 0 To UBound(RangeNames)
startFy = Right(RangeNames(i), 2)
endFy = Right(RangeNames(i) + 1, 2)
sheetName = sheetPrefix & startFy & "-" & endFy
Set newWorkSheet = Sheets.Add
newWorkSheet.Name = sheetName
baseRange.Copy Destination:=newWorkSheet.Range("A1")
RangesToCopy(i).Copy Destination:=newWorkSheet.Range("A9")
Next i




End Sub

Function GetSchoolFiscalYear(currentRange As Range) As Integer
Dim dateValue As Date
Dim yearValue As Integer

dateValue = currentRange.Value
If Month(dateValue) > 7 Then
dateValue = DateAdd("yyyy", 1, dateValue)
End If
GetSchoolFiscalYear = Year(dateValue)
End Function