Receiving Overflow Error - is there a workaround?

[RussG]

I am trying to split a file of 65,000 rows into separate files based on a fund code in column A, and using a fund number in column H to name the file. When running the macro, it is working fine for about 30 files, and then I receive an Overflow error. I am thinking this is because of the large number of rows in the original excel sheet. Is there a workaround to this error?

There are 88 unique fund codes in these 65,000 rows.

Sub Q28_RUN()
'
Dim i As Integer
Dim j As Integer
Dim fund_code As Variant
Dim fund_number As Variant
'
Workbooks("TEST.xls").Activate
'
Worksheets(1).Range(Cells(2, 1), Cells(2, 8).End(xlDown)).Sort _
    key1:=Worksheets(1).Cells(2, 1), Header:=xlNo
'
i = 2
j = 1
fund_code = Worksheets(1).Cells(i, 1)
fund_number = Worksheets(1).Cells(i, 8)
'
Do Until fund_code = ""
'
    Workbooks.Add
    '
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Q28_" & fund_number, _
        FileFormat:=xlNormal, ReadOnlyRecommended:=False, CreateBackup:=False
    '
    Workbooks("TEST.xls").Activate
    Worksheets(1).Range("A1:H1").Select
    Selection.Copy
    Workbooks("Q28_" & fund_number & ".xls").Activate
    Worksheets(1).Range("A1:H1").Select
    ActiveSheet.Paste
    '
    Workbooks("TEST.xls").Activate
    '
        Do Until Worksheets(1).Cells(i + j, 1) <> fund_code
            '
            j = j + 1
            '
        Loop
    '
    Worksheets(1).Range(Cells(i, 1), Cells(i + j - 1, 8)).Select
    Selection.Copy
    Workbooks("Q28_" & fund_number & ".xls").Activate
    Worksheets(1).Range(Cells(2, 1), Cells(2 + j - 1, 8)).Select
    ActiveSheet.Paste


    Workbooks("Q28_" & fund_number & ".xls").Activate
    Workbooks("Q28_" & fund_number & ".xls").Save
    Workbooks("Q28_" & fund_number & ".xls").Close
    '
    Workbooks("TEST.xls").Activate
    '
    i = i + j
    j = 1
    fund_code = Worksheets(1).Cells(i, 1)
    fund_number = Worksheets(1).Cells(i, 8)
    '
Loop
'
End Sub

Also, as an added bonus, if anyone knows how to automatically confirm the Compatibility Checker when saving each of these files, I would appreciate it. Currently, I have to select confirm every time it saves one of the files.

Thank you!

 

[shg]

Replace Integer with Long.

as an added bonus ...

Application.DisplayAlerts = False

 

[RussG]

Thanks shg, that worked up until the last file. I got an error on the last file where it did not copy over the data to the new workbook. Brought up the debugger and it highlighted the following code:

Do Until Worksheets(1).Cells(i + j, 1) <> fund_code

 

[shg]

Help yourself a little, Russ: What errror, what are the values of all of the variables in that statement when the error occurs?

 

[RussG]

I actually figured it out by adding a blank row at the bottom of the sheet. If you hadn't guessed, I did not write the original code, I'm just trying to tweak it to fit my application. I noticed it was looping until it found a blank cell. So adding the blank row stopped the error. I realized my question was a little vague..... lol

 

[shg]

Glad you got it sorted. Here's a way that avoids all of the selecting (but competely untested):

Sub Q28_RUN()
    Dim wksTest     As Worksheet
    Dim wksQ28      As Worksheet
    
    Dim iRow        As Long
    Dim iOfs        As Long
    
    Dim vFund       As Variant
    Dim vNum        As Variant

    Set wksTest = Workbooks("TEST.xls").Worksheets(1)
    With wksTest
        .Range("A2:H2").End(xlDown).Sort Key1:=.Range("A2"), Header:=xlNo

        iRow = 2
        iOfs = 1

        vFund = .Cells(iRow, "A").Value
        vNum = .Cells(iRow, "H").Value

        Do Until vFund = ""
            Workbooks.Add
            ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Q28_" & vNum
            Set wksQ28 = ActiveWorkbook.Worksheets(1)

            .Range("A1:H1").Copy wksQ28.Range("A1")
            Do While .Cells(iRow + iOfs, "A").Value <> vFund
                iOfs = iOfs + 1
            Loop

            .Rows(iRow).Resize(iOfs, 8).Copy wksQ28.Range("A2")
            ActiveWorkbook.Close SaveChanges:=True

            iRow = iRow + iOfs
            iOfs = 1
            vFund = .Cells(iRow, "A").Value
            vNum = .Cells(iRow, "H").Value
        Loop
    End With
End Sub