Array error in subtotal method
Thanks Dave,
I'm still having the same problem though - the "subtotal method of
range class failed" error. I've now built an array instead of a text
string but I can't work out where my syntax is incorrect. The code is
now as follows:
Dim rs As DAO.Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim Row As Integer
Dim Col As Integer
Dim TotRange As String
Dim NumRange As String
Dim ArrCount As Integer
Dim ArrString As Variant
Dim ArrInt As Integer
Dim MyArray() As Variant
Dim list As Variant
Row = 1
Col = 1
Set rs = CurrentDb.OpenRecordset(TableName, dbOpenSnapshot)
intMaxCol = rs.Fields.Count + 1
If rs.RecordCount 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
Set objXL = New Excel.Application
TotRange = CLetter(1) & ":" & CLetter(CLng(intMaxCol))
NumRange = CLetter(4) & ":" & CLetter(CLng(intMaxCol))
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
With objSht
For FNameInt = LBound(FName) To UBound(FName)
.Cells(Row, Col) = FName(FNameInt)
Col = Col + 1
Next
.Range(.Cells(2, 1), .Cells(intMaxRow,
intMaxCol)).CopyFromRecordset rs
ArrInt = 1
For ArrCount = 4 To intMaxCol
Select Case ArrCount
Case 4
ArrString = 4 & ","
Case intMaxCol
ArrString = ArrString & ArrCount
Case Else
ArrString = ArrString & ArrCount & ","
End Select
ReDim Preserve MyArray(1 To ArrInt + 1)
MyArray(ArrInt) = ArrCount
Debug.Print "MyArray(" & ArrInt & ")" & " = " &
ArrCount
ArrInt = ArrInt + 1
Next
.Range(.Cells(1, 1), .Cells(intMaxRow + 1, intMaxCol -
1)).Select
Range(TotRange).Subtotal GroupBy:=1,
Function:=xlSum, _
TotalList:=MyArray(), _
Replace:=True, PageBreaks:=False,
SummaryBelowData:=True
.Columns(TotRange).AutoFit
End With
End With
End If
End Function
Dave Peterson wrote:
Untested...
Instead of:
TotalList:=Array(Split(ArrString, ","))
try:
TotalList:=Split(ArrString, ",")
Split returns an array--so array isn't needed (and shouldn't be used).
And maybe it would be easier to just build the array.
I don't know the DAO stuff, but this might give you an idea:
Option Explicit
Sub testme()
Dim myArr() As Long
Dim iCtr As Long
Dim MaxCols As Long
MaxCols = 12 'say
ReDim myArr(4 To MaxCols)
For iCtr = 4 To MaxCols
myArr(iCtr) = iCtr
Next iCtr
' ....TotalList:=myarr, ....
End Sub
Bob wrote:
Hi all,
I've copied a recordset from access to excel and I want to do some
formatting on
it once its in excel. I'm having a problem with the subtotal
method - its the 'TotalList:=array(1,2,3) etc that I'm having trouble
with. I need to insert an array into that value to get totals for
however many columns there are after the 4th column. with the current
code I'm getting a 'Subtotal method of range class failed' error.
Code below:
Any help would be appreciated!
Dim rs As DAO.Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim Row As Integer
Dim Col As Integer
Dim TotRange As String
Dim NumRange As String
Dim ArrCount As Integer
Dim ArrString As String
Dim ArrInt As Integer
Row = 1
Col = 1
Set rs = CurrentDb.OpenRecordset(TableName, dbOpenSnapshot)
intMaxCol = rs.Fields.Count + 1
If rs.RecordCount 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
Set objXL = New Excel.Application
TotRange = CLetter(1) & ":" & CLetter(CLng(intMaxCol))
NumRange = CLetter(4) & ":" & CLetter(CLng(intMaxCol))
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
With objSht
For FNameInt = LBound(FName) To UBound(FName)
.Cells(Row, Col) = FName(FNameInt)
Col = Col + 1
Next
.Range(.Cells(2, 1), .Cells(intMaxRow,
intMaxCol)).CopyFromRecordset rs
ArrInt = 4
For ArrCount = 4 To intMaxCol
Select Case ArrCount
Case 4
ArrString = 4 & ","
Case intMaxCol
ArrString = ArrString & ArrCount
Case Else
ArrString = ArrString & ArrCount & ","
End Select
Next
'.Range("A3").Select
'Select Case intMaxCol
.Range(.Cells(1, 1), .Cells(intMaxRow + 1,
intMaxCol - 1)).Subtotal GroupBy:=1, Function:=xlSum, _
TotalList:=Array(Split(ArrString, ",")),
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
.Columns(TotRange).AutoFit
End With
End With
End If
--
Dave Peterson
|