Pushing the issue further, and upstream of this module, how would I
assuming that the data to be summed is in row 2 to 7 (instead of 8 to
13)
1. Populate an array with a list of unique codes from the above
2. Insert the number of summary rows and the blank total row
3. Populate the criteria column with the list of unique codes
before running TotalIf

Data starts in row 2, for any length of rows and is pushed down to
accommodate any number of unique criteria.

Sub TotalIf()
Dim TblRng As String 'for SUMIF formula
Dim CritRng As String 'for SUMIF formula
Dim SumRng As String 'for SUMIF formula
Dim MyRng As Range 'where formula goes
Dim FrmlRow As Long 'row for formula
Dim FrmlCol As Integer 'column for formula
Dim LastRow As Long, LastCol As Long 'for unique list
Dim TblFRow As Long, TblLRow As Long 'define table

'Make unique list and move data down
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
Range("A1:A" & LastRow).AdvancedFilter Action:=xlFilterCopy, _
CopyToRange:=Cells(1, LastCol + 1), Unique:=True
LastRow = Cells(Rows.Count, LastCol + 1).End(xlUp).Row
Range("A2", Cells(LastRow + 3, LastCol)).Insert Shift:=xlDown
Range(Cells(1, LastCol + 1), Cells(LastRow, LastCol + 1)).Cut Range("A1")
Cells(LastRow + 2, 1).Value = "Totals"
With Range(Cells(LastRow + 2, 1), Cells(LastRow + 2, LastCol + 1))
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
End With

TblFRow = LastRow + 4
TblLRow = Cells(Rows.Count, "A").End(xlUp).Row
TblRng = Range(Cells(TblFRow, 1), Cells(TblLRow, LastCol)).Address 'where
data is
FrmlRow = 2 'first formula row
FrmlCol = 2 'first formula column

For FrmlCol = 2 To LastCol
If FrmlCol = 4 Then FrmlCol = LastCol 'skips col 4 & 5
CritRng = Range("A" & FrmlRow).Address
SumRng = Range(Cells(TblFRow, FrmlCol), Cells(TblLRow,
FrmlCol)).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlCol = LastCol Then
Set MyRng = Cells(FrmlRow, FrmlCol + 1)
SumRng = Range(Cells(FrmlRow, 2), Cells(FrmlRow, 3)).Address
SumRng = Range(SumRng & "," & (Cells(FrmlRow,
6).Address)).Address
SumRng = Replace(SumRng, "$", "")
MyRng.Formula = "=SUM(" & SumRng & ")"
Range(MyRng.Address, MyRng.Offset(LastRow - 2,
0).Address).FillDown
SumRng = Range(Cells(TblFRow, FrmlCol), Cells(TblLRow,
FrmlCol)).Address
End If
FrmlRow = FrmlRow + 1 'go to next row
For FrmlRow = 3 To LastRow
CritRng = Range("A" & FrmlRow).Address
Set MyRng = Cells(FrmlRow, FrmlCol)
MyRng.Formula = "=Sumif(" & TblRng & "," & CritRng & "," & SumRng &
")"
If FrmlRow = LastRow Then
Set MyRng = Cells(FrmlRow + 2, FrmlCol)
SumRng = Range(Cells(2, FrmlCol), Cells(FrmlRow,
FrmlCol)).Address
MyRng.Formula = "=Sum(" & SumRng & ")"
End If
Next
FrmlRow = 2 'go back to first row
Next
End Sub

Run this code line by line and study what each line does as you watch the
worksheet. There is a lot to learn in how this code works.
Mike F
"u473" wrote in message
ups.com...
1. Yes, Row # 1 is the header Row.
2. Column D is Text for Type of Charge, Column E is Text for Forecast
Variance Justification Comments.
Thank you for your help, this is a real education. I wish I could find
the above in textbooks.
Wayne