Subtotal above the pivot table

[Aswinraj]

Hello Guys,

I have a Pivot table, where i need to add new row above the pivot table and show the subtotal of each column till last available Column. (Pivot range may vary)

Below is the code which i tried but it was not working correctly. Please help.

    LR = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    LC = ActiveSheet.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    LCell = Cells(LR, LC).Address
    myrange = "C10:" & LCell
    Subtotal = ""
    Range(myrange).Select
    
    If Range("E" & LC).Value <> "" Then
        Range("E7" & LC).Formula = "=SUBTOTAL(9 & LR & )"
    End If

 

[Anthony47]

Cannot you use just =Subtotal(9,C13:C10000)/2
If the table dont have a Grand Total at the bottom then remove the "/2"

Bye

 

[Aswinraj]

This doesnt solve my problem. Pivot Column range may vary.. So i need to create a Subtotal in dynamic way to add formula till last available column.

The above code which you provided just add to only one column (static).
@Anthony47

 

[Anthony47]

Hummm... Could you please explain what you would like to calculate?
Bye

 

[Aswinraj]

@Anthony47

I have a Pivot table, where i need to add new row above the pivot table and show the subtotal of each column till last available Column. (Pivot both column and row range may vary).

Basically I need to add =SUBTOTAL formula till last column available by selecting till last row.

 

[Anthony47]

Well, in your situation (flexible rows count, flexible columns count) it obvious that the pivot table has free columns to the right and free rows at the bottom.
So you could set all the fomulas to all the possible columns; just insert the first formula, then copy it to the right till enough columns are covered
If you don't like that the useless (those in excess with respect the current columns count) you could make the formula a little bit more complex, like

=IF(C12="";"";Subtotal(9,C13:C10000)/2)

I am supposing that row #12 contains the pivot column headers; so if there is no any header, the formula will show nothing.

If you wish to make it the difficult way, you might consider using the following macro:

Sub Pvt_Tot_Total()
Dim pSheet As Worksheet, cRan As String
Dim pCC As Long, pRC As Long, aTots, bTots
Dim pvSh As String, pvCell As String
Dim FormulaRow As Long, FormulaCol As Long
'
pvSh = "Pivot"          '<<< The worksheet name
pvCell = "A8"           '<<< First top cell of the PivotTable
FormulaRow = 4          '<<< Row where the formulas will be written
'
Set pSheet = Sheets(pvSh)
PV1 = pSheet.Range(pvCell).PivotTable.Name
FormulaCol = pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Column
pCC = pSheet.PivotTables(PV1).DataBodyRange.Columns.Count
pRC = pSheet.PivotTables(PV1).DataBodyRange.Rows.Count
On Error Resume Next
'Check if PivotTable has GrandTotal at the bottom:
    aTots = Application.WorksheetFunction.Sum(pSheet.PivotTables(PV1).DataBodyRange)
    bTots = Application.WorksheetFunction.Sum(pSheet.PivotTables(PV1).DataBodyRange.Cells(1, 1).Resize(pRC - 1, pCC))
    If Round(aTots / atot2, 6) = 2 Then pRC = pRC - 1
On Error GoTo 0
'Clear existing formulas...
pSheet.Cells(FormulaRow, FormulaCol).Resize(1, pCC + 5).ClearContents
'...and set the new ones
For I = 1 To pCC
    cRan = pSheet.PivotTables(PV1).DataBodyRange.Cells(1, I).Resize(pRC, 1).Address
    pSheet.Cells(FormulaRow, FormulaCol + I - 1).Formula = "=Sum(" & cRan & ")"
Next I
End Sub

Put the code into a standard vba module; the lines marked <<< had to be customized according the comment.s
Conceptually, it uses the property "DataBodyRange" of the pivot, but I made it a little bit more complex to let you use it on several pivottables. You identify the pivottable by specifying the worksheet name and its first used cell (any cell will work, but using the first one is better)
Also, the code try to understand if the bottom line within the pivottable is a GrandTotal, and in that case that line is excluded from the formula

I suggest that you start the macro whenever the pivottable get recalculated; you can obtain that simply by inserting "Call Pvt_Tot_Total" (without "quotes") into the Worksheet_PivotTableUpdate (event driven) subroutine.

Bye

 

[Aswinraj]

@Anthony47 Works Perfectly. Thank you so Much. After long search and many people unable to solve it but you did it like a charm.

With Regards,
Aswinraj A