Totalling Range Values
 

I seem to be having a problem with this code. I have a spreadhseet
with a multitude of items. These items have been grouped by their item
number. Separating each grouping are two blank rows. I would like to
total the values in the 6th column of the individual item groupings and
insert that value directly below the last item in the group. Any and
all help is much appreciated. Thanks in advance. My VBA code is
located below.

Sub Totals()

Dim TotalFreq As Range
Set TotalFreq = Range(Cells(StartRow, 6), Cells(EndRow, 6))
If StartRow = EndRow Then
SumFreq = Cells(StartRow, 6).Value
Else: SumFreq = Application.WorksheetFunction.Sum(TotalFreq)
End If
LastRow = Range("A65532").End(xlUp).Row
ThisItem = Cells(I, 1).Value
NextItem = Cells(I + 1, 1).Value
PrevItem = Cells(I - 1, 1).Value

For I = 3 To LastRow
If IsEmpty(ThisItem) Then
ElseIf ThisItem = NextItem Then
If ThisItem < PrevItem Then
StartRow = I
End If
ElseIf ThisItem = NextItem Then
If ThisItem = PrevItem Then
End If
ElseIf ThisItem = PrevItem Then
If IsEmpty(NextItem) Then
EndRow = I
End If
End If
Cells(I + 1, 6).Value = SumFreq
Next I
End Sub

Totalling Range Values
 

Maybe like this:

Sub Totals()
Dim eRow As Long
Dim fRow As Long
Dim lRow As Long
eRow = Cells(Rows.Count, 1).End(xlUp).Row
fRow = 2
Do Until lRow = eRow + 1
lRow = Cells(fRow, 6).End(xlDown).Row + 1
Cells(lRow, 6).FormulaR1C1 = _
"=SUM(R[-" & lRow - fRow & "]C:R[-1]C)"
fRow = lRow + 2
Loop
End Sub

Hope this helps
Rowan

wrote:
I seem to be having a problem with this code. I have a spreadhseet
with a multitude of items. These items have been grouped by their item
number. Separating each grouping are two blank rows. I would like to
total the values in the 6th column of the individual item groupings and
insert that value directly below the last item in the group. Any and
all help is much appreciated. Thanks in advance. My VBA code is
located below.

Sub Totals()

Dim TotalFreq As Range
Set TotalFreq = Range(Cells(StartRow, 6), Cells(EndRow, 6))
If StartRow = EndRow Then
SumFreq = Cells(StartRow, 6).Value
Else: SumFreq = Application.WorksheetFunction.Sum(TotalFreq)
End If
LastRow = Range("A65532").End(xlUp).Row
ThisItem = Cells(I, 1).Value
NextItem = Cells(I + 1, 1).Value
PrevItem = Cells(I - 1, 1).Value

For I = 3 To LastRow
If IsEmpty(ThisItem) Then
ElseIf ThisItem = NextItem Then
If ThisItem < PrevItem Then
StartRow = I
End If
ElseIf ThisItem = NextItem Then
If ThisItem = PrevItem Then
End If
ElseIf ThisItem = PrevItem Then
If IsEmpty(NextItem) Then
EndRow = I
End If
End If
Cells(I + 1, 6).Value = SumFreq
Next I
End Sub