subtotal problem

[thoomas]

I'm still struggling with the subtotal macro. I would like to copy the result of the subtotal from the bottom of the previous page onto the top of the new page, but not into the column where SUM() function exists, but into the column just BEFORE that SUM() column. Is it possible? I tried to do this by myself, but as far as I'm complete newbie in coding, I was not successful. Thanx for any help...In the following code (credits go to btadams!) I have the situation where the code copies the subtotal into the SUM column (F), but I need to copy it into the column E. How should one modify that code?

Private Sub InsertSubTotal(RowIndex As Long, PreviousPageBreak As Long, InsertNewRows As Boolean, LabelText As String) 
' contains all editing necessary for each subtotal at the bottom of each page 
' customization is necessary depending on the subtotals you want to add 
Const RowsToInsert As Long = 3 
Dim i As Long, TargetRow As Long 
    TargetRow = RowIndex 
    If InsertNewRows Then ' not the last subtotal 
        For i = 1 To 2 * RowsToInsert 
            Rows(RowIndex - RowsToInsert).Insert 
        Next i 
        TargetRow = RowIndex - RowsToInsert 
    End If 
    If PreviousPageBreak < 1 Then PreviousPageBreak = 1 
    ' insert the necessary subtotal formulas here: 
    ' ADD ONE BLANK ROW BEFORE SUB-TOTAL 
    Cells(TargetRow + 1, 1).Formula = LabelText 
    With Cells(TargetRow + 1, 6) 
        .Formula = "=subtotal(9,r[-" & TargetRow - PreviousPageBreak & "]c:r[-1]c)" 
        .NumberFormat = .Offset(-2, 0).NumberFormat 
    End With 
    Range(Cells(TargetRow + 1, 1), Cells(TargetRow, 6)).Font.Bold = True 
    Range(Cells(TargetRow + 1, 1), Cells(TargetRow, 6)).Copy 
    Range(Cells(TargetRow + 4, 1), Cells(TargetRow + 3, 6)).PasteSpecial (xlPasteValues) 
    Range(Cells(TargetRow + 4, 1), Cells(TargetRow + 3, 6)).Font.Bold = True 
End Sub

 

[SydneyGeek]

...I have the situation where the code copies the subtotal into the SUM column (F), but I need to copy it into the column E. How should one modify that code?

Private Sub InsertSubTotal(RowIndex As Long, PreviousPageBreak As Long, InsertNewRows As Boolean, LabelText As String) 
' contains all editing necessary for each subtotal at the bottom of each page 
' customization is necessary depending on the subtotals you want to add 
'snip
    Range(Cells(TargetRow + 1, 1), Cells(TargetRow, 6)).Font.Bold = True 
    Range(Cells(TargetRow + 1, 1), Cells(TargetRow, 6)).Copy 
    Range(Cells(TargetRow + 4, 1), Cells(TargetRow + 3, 6)).PasteSpecial (xlPasteValues) 
    Range(Cells(TargetRow + 4, 1), Cells(TargetRow + 3, 6)).Font.Bold = True 
End Sub

Hi thoomas, where it says Cells (TargetRow, 6) make that Cells(TargetRow, 5)

Denis

 

[thoomas]

Thanks for your reply...But your solution does not work. I wonder what should be changed on the line where Range(Cells(TargetRow +4, 1...) is?

 

[SydneyGeek]

Oops -- missed one.
This ... With Cells(TargetRow + 1, 6)
Should be... With Cells(TargetRow + 1, 5)

Denis

 

[thoomas]

sorry, but does not work that way....

 

[SydneyGeek]

Could you post a sample of your worksheet? I'm having trouble visualising the layout. (Use Colo's HYML Maker -- links on the Excel board's Index page)

Denis

 

[thoomas]

It works now this way:

Private Sub InsertSubTotal(RowIndex As Long, PreviousPageBreak As Long, InsertNewRows As Boolean, LabelText As String)
' contains all editing necessary for each subtotal at the bottom of each page
' customization is necessary depending on the subtotals you want to add
Const RowsToInsert As Long = 2
Dim i As Long, TargetRow As Long
    TargetRow = RowIndex
    If InsertNewRows Then ' not the last subtotal
        For i = 1 To 2 * RowsToInsert
            Rows(RowIndex - RowsToInsert).Insert
        Next i
        TargetRow = RowIndex - RowsToInsert
    End If
    If PreviousPageBreak < 1 Then PreviousPageBreak = 1
    ' insert the necessary subtotal formulas here:
    ' ADD ONE BLANK ROW BEFORE SUB-TOTAL
    Cells(TargetRow + 1, 4).Formula = LabelText
    With Cells(TargetRow + 1, 6)
        .Formula = "=subtotal(9,r[-" & TargetRow - PreviousPageBreak & "]c:r[-1]c)"
        .NumberFormat = .Offset(-2, 0).NumberFormat
    End With
    Range(Cells(TargetRow + 1, 1), Cells(TargetRow, 6)).Font.Bold = True
    Range(Cells(TargetRow + 1, 6), Cells(TargetRow, 6)).Copy
    Range(Cells(TargetRow + 1, 5), Cells(TargetRow + 2, 5)).PasteSpecial (xlPasteValues)
    Range(Cells(TargetRow + 1, 5), Cells(TargetRow + 2, 5)).Font.Bold = True
        
End Sub

The problem was that it didn't let me copy the entire row, so now I copied only SUM cell and it seems to work now. Thanks for your answers..