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

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

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

Still untested:

Option Explicit
Sub testme01()

Dim rs As Object 'DAO.Recordset
Dim intMaxCol As Long
Dim intMaxRow As Long
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim Row As Long
Dim Col As Long
Dim TotRange As String
Dim NumRange As String
Dim ArrCount As Long
Dim ArrString As Variant
Dim ArrInt As Long
Dim MyArray() As Variant
Dim list As Variant
Dim FNameInt As Long

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 FNameInt

.Range(.Cells(2, 1), .Cells(intMaxRow, intMaxCol)) _
.CopyFromRecordset rs

ReDim Preserve MyArray(4 To intMaxCol)
For ArrCount = 4 To intMaxCol
MyArray(ArrInt) = ArrCount
Next ArrCount

' .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 Sub




Bob wrote:
>
> 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

--

Dave Peterson

My main problem wasn't the array, but I had messed about the intMaxCol
variable so I was trying to add more columns to the array than existed
- hence the error.

Thanks a lot for your help Dave.

Cheers.

Dave Peterson wrote:
> Still untested:
>
> Option Explicit
> Sub testme01()
>
> Dim rs As Object 'DAO.Recordset
> Dim intMaxCol As Long
> Dim intMaxRow As Long
> Dim objXL As Excel.Application
> Dim objWkb As Workbook
> Dim objSht As Worksheet
> Dim Row As Long
> Dim Col As Long
> Dim TotRange As String
> Dim NumRange As String
> Dim ArrCount As Long
> Dim ArrString As Variant
> Dim ArrInt As Long
> Dim MyArray() As Variant
> Dim list As Variant
> Dim FNameInt As Long
>
> 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 FNameInt
>
> .Range(.Cells(2, 1), .Cells(intMaxRow, intMaxCol)) _
> .CopyFromRecordset rs
>
> ReDim Preserve MyArray(4 To intMaxCol)
> For ArrCount = 4 To intMaxCol
> MyArray(ArrInt) = ArrCount
> Next ArrCount
>
> ' .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 Sub
>
>
>
>
> Bob wrote:
> >
> > 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
>
> --
>
> Dave Peterson

I still think that this technique is more straightforward:

> > ReDim Preserve MyArray(4 To intMaxCol)
> > For ArrCount = 4 To intMaxCol
> > MyArray(ArrInt) = ArrCount
> > Next ArrCount


Bob wrote:
>
> My main problem wasn't the array, but I had messed about the intMaxCol
> variable so I was trying to add more columns to the array than existed
> - hence the error.
>
> Thanks a lot for your help Dave.
>
> Cheers.
>
> Dave Peterson wrote:
> > Still untested:
> >
> > Option Explicit
> > Sub testme01()
> >
> > Dim rs As Object 'DAO.Recordset
> > Dim intMaxCol As Long
> > Dim intMaxRow As Long
> > Dim objXL As Excel.Application
> > Dim objWkb As Workbook
> > Dim objSht As Worksheet
> > Dim Row As Long
> > Dim Col As Long
> > Dim TotRange As String
> > Dim NumRange As String
> > Dim ArrCount As Long
> > Dim ArrString As Variant
> > Dim ArrInt As Long
> > Dim MyArray() As Variant
> > Dim list As Variant
> > Dim FNameInt As Long
> >
> > 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 FNameInt
> >
> > .Range(.Cells(2, 1), .Cells(intMaxRow, intMaxCol)) _
> > .CopyFromRecordset rs
> >
> > ReDim Preserve MyArray(4 To intMaxCol)
> > For ArrCount = 4 To intMaxCol
> > MyArray(ArrInt) = ArrCount
> > Next ArrCount
> >
> > ' .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 Sub
> >
> >
> >
> >
> > Bob wrote:
> > >
> > > 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
> >
> > --
> >
> > Dave Peterson

--

Dave Peterson