Subtotal method adds the grand total way further down on the sheet

Hello

I have a spreadsheet and I need to repeat subtotaling the rows( around 2000); everytime I do it, through macro, the Grand total is added way furhter down on the sheet; what can I do?

Thanks!

Sure..

<<Sub CreateJERecords(ParamArray RecInfo() As Variant)
Dim SourceSheet As String
Dim DestinSheet As String
Dim ColToSorting As String
Dim AmountCol As Long
Dim ComboCol As Long
Dim TotalRecAdd As String
Dim CurrTotalCell As String
Dim NxtCurrTotalCell As String
Dim FCurrTotalCell As String
Dim LCurrTotalCell As String
Dim FNxtTotalCell As Variant
Dim LNxtTotalCell As Variant

SourceSheet = RecInfo(0)
DestinSheet = RecInfo(1)
ColToSorting = RecInfo(2)
AmountCol = RecInfo(3)
ComboCol = RecInfo(4)

Sheets(SourceSheet).Activate
ActiveSheet.Cells.Select
Selection.Copy

Sheets(DestinSheet).Activate
ActiveSheet.Cells.Select
' ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

CutCopyMode = False

Rows("1:1").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Cells.Select


Selection.Sort Key1:=Range(ColToSorting), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal

Selection.Subtotal GroupBy:=ComboCol, Function:=xlSum, TotalList:=Array(AmountCol), _
Replace:=False, PageBreaks:=False, SummaryBelowData:=True

'identify and select information for populating the JE file

ActiveSheet.Columns(ComboCol).Cells(2, 1).Select

Do
If ActiveCell.Font.Bold = True Then
CurrTotalCell = ActiveCell.Address

GoLeft
GoUp
LCurrTotalCell = ActiveCell.Address
ActiveCell.Offset(0, -5).Select
FCurrTotalCell = ActiveCell.Address
TotalRecAdd = FCurrTotalCell & ":" & LCurrTotalCell
FNxtTotalCell = Left(FCurrTotalCell, InStr(2, FCurrTotalCell, "$", vbBinaryCompare)) & _
(CInt(Right(FCurrTotalCell, (Len(FCurrTotalCell) - InStr(2, FCurrTotalCell, "$", vbBinaryCompare)))) + 1)

LNxtTotalCell = Left(LCurrTotalCell, InStr(2, LCurrTotalCell, "$", vbBinaryCompare)) & _
(CInt(Right(LCurrTotalCell, (Len(LCurrTotalCell) - InStr(2, LCurrTotalCell, "$", vbBinaryCompare)))) + 1)

NxtCurrTotalCell = FNxtTotalCell & ":" & LNxtTotalCell
Range(TotalRecAdd).Select
Selection.Copy

Range(NxtCurrTotalCell).Select
ActiveSheet.Paste
CutCopyMode = False

Range(CurrTotalCell).Select
GoDown

Else
GoDown
End If
Loop Until ActiveCell.Value = "Grand Total"


MsgBox ActiveCell.Address
' ActiveSheet.Outline.ShowLevels RowLevels:=2

Range("A1").Select

End Sub>>

I have the same issue going on. I need to subtotal a sheet with a variable number of rows. I have the macro to subtotal a sprcific number of rows (more than I need - say 150 and the actual number of rows is less than that), and when subtotalling the grand total is way below the last row. I am guessing there is a way to subtotal only the number of actual rows, but I don't know what that would be. The last bit of code is the subtotal. Here is the code:

Please Login or Register  to view this content.