It doesn't look like a matter of exceeding the number of rows or columns. There are no worksheets that have more than the 65,000 record limit. There are 70 different values in column A that need their own spreadsheet. Then, another problem is that it is not grouping correctly on the summary sheet. Instead of summing for all entries of "001", it is putting a line in several times. I will post the code below.
Option Explicit
Sub CreateHubSheets()
Dim thub As String
Dim lashub As String
Dim shenam As String
Dim wHub As Worksheet
Dim ir As Long
Dim first As Boolean
' Open Database
Set GDB = OpenDatabase("N:PPO RevenuePPORevenue1.mdb")
Set RST = GDB.OPENRECORDSET("DETAIL", dbOpenDynaset)
Reset
Set WSUM = CreateSheet("SUM", "TSUM")
ISROW = K_1STSUMROW
'Pass table and break on new hub number
first = True
Do While (Not RST.EOF)
If (IsNull(RST!HUBSITE)) Then
thub = "_Invalid"
Else
thub = RST!HUBSITE
End If
If (thub <> lashub) Then
If (Not first) Then
Update_Summary
ISROW = ISROW + 1
End If
first = False
shenam = "HUB" & thub
Set wHub = CreateSheet(shenam, "THUB")
lashub = thub
ir = K_1STHUBROW
WSUM.Cells(ISROW, K_SUMHUBNUMCOL) = thub
WSUM.Cells(ISROW, K_SUMHUBNAMCOL) = RST!SITE_NAME
End If
wHub.Cells(ir, K_HUBNUMCOL) = RST!HUBSITE
wHub.Cells(ir, K_HUBNAMCOL) = RST!SITE_NAME
wHub.Cells(ir, K_HUBMACNUMCOL) = RST!MACHINE
wHub.Cells(ir, K_HUBMACNAMCOL) = RST!machname
wHub.Cells(ir, K_HUBSTACOL) = RST!ST
wHub.Cells(ir, K_HUBCONNUMCOL) = RST!CONTRACT#
wHub.Cells(ir, K_HUBBATNUMCOL) = RST!BATCH
wHub.Cells(ir, K_HUBSHENUMCOL) = RST!SHEET
wHub.Cells(ir, K_HUBCHAAMTCOL) = RST!CHARGE
wHub.Cells(ir, K_HUBSTDREDCOL) = RST!PPOSTDREDUCT
wHub.Cells(ir, K_HUBPPOSAVCOL) = RST!PPOSAVINGS
wHub.Cells(ir, K_HUBPPOREVCOL) = RST!PPOREVENUE
wHub.Cells(ir, K_HUBSAVPCTCOL).Formula = "=RC[-2] / ( RC[-4] - RC[-3])"
ir = ir + 1
TOTCHARGE = TOTCHARGE + RST!CHARGE
TOTPPOSTDREDUCT = TOTPPOSTDREDUCT + RST!PPOSTDREDUCT
TOTPPOSAVINGS = TOTPPOSAVINGS + RST!PPOSAVINGS
TOTPPOREVENUE = TOTPPOREVENUE + RST!PPOREVENUE
RST.MoveNext
Loop
Update_Summary
ISROW = ISROW + 1
WSUM.Cells(ISROW, K_SUMCHAAMTCOL) = GTOTCHARGE
WSUM.Cells(ISROW, K_SUMSTDREDCOL) = GTOTPPOSTDREDUCT
WSUM.Cells(ISROW, K_SUMPPOSAVCOL) = GTOTPPOSAVINGS
WSUM.Cells(ISROW, K_SUMPPOREVCOL) = GTOTPPOREVENUE
WSUM.Cells(ISROW, K_SUMSAVPCTCOL).Formula = "=RC[-2] / ( RC[-4] - RC[-3])"
Sheets("SUM").Select
RST.Close
End Sub
' Delete old / Create new worksheet based on master
'--------------------------------------------------
Function CreateSheet(xSheetName, xType) As Worksheet
Dim wnew As Worksheet
Dim wmaster As Object
Dim sheetname As String
Set wmaster = Sheets(xType)
sheetname = xSheetName
Application.DisplayAlerts = False
On Error Resume Next
Sheets(sheetname).Delete
On Error GoTo 0
Application.DisplayAlerts = True
wmaster.Copy Before:=Sheets("THUB")
Set wnew = ActiveSheet
wnew.Name = sheetname
Set CreateSheet = wnew
End Function
' Reset
'-------------------------------------------------------
Sub Reset()
Dim WD As Worksheet
Dim ir As Long
For Each WD In Worksheets
If (Left(WD.Name, 3) = "HUB" Or Left(WD.Name, 3) = "SUM") Then
Application.DisplayAlerts = False
On Error Resume Next
WD.Delete
On Error GoTo 0
Application.DisplayAlerts = True
End If
Next WD
End Sub
'
'Update Summary Sheet
'-----------------------------------------------------------
Sub Update_Summary()
WSUM.Cells(ISROW, K_SUMCHAAMTCOL) = TOTCHARGE
WSUM.Cells(ISROW, K_SUMSTDREDCOL) = TOTPPOSTDREDUCT
WSUM.Cells(ISROW, K_SUMPPOSAVCOL) = TOTPPOSAVINGS
WSUM.Cells(ISROW, K_SUMPPOREVCOL) = TOTPPOREVENUE
WSUM.Cells(ISROW, K_SUMSAVPCTCOL).Formula = "=RC[-2] / ( RC[-4] - RC[-3])"
GTOTCHARGE = GTOTCHARGE + TOTCHARGE
GTOTPPOSTDREDUCT = GTOTPPOSTDREDUCT + TOTPPOSTDREDUCT
GTOTPPOSAVINGS = GTOTPPOSAVINGS + TOTPPOSAVINGS
GTOTPPOREVENUE = GTOTPPOREVENUE + TOTPPOREVENUE
TOTCHARGE = 0
TOTPPOSTDREDUCT = 0
TOTPPOSAVINGS = 0
TOTPPOREVENUE = 0
End Sub