Hi,

Is there any way of combining the following two Subs into one? Or it looks messay.

Thanks.

Sub SumByGroup(keyfield As String, datacol As Integer, destcol As Integer)
'keyfield: the field of key, datacol: Offset number, if keyfield is "a" then datacol=2 means data in field "c"
'destcol: Offset number, similar to datacol
Range(keyfield).Activate
While ActiveCell <> ""
x = 0
y = 0
While ActiveCell = ActiveCell.Offset(1)
If ActiveCell = ActiveCell.Offset(1) Then
x = x + 1
y = y + ActiveCell.Offset(, datacol)
End If
ActiveCell.Offset(, destcol) = y
ActiveCell.Offset(1).Activate
Wend
x = x + 1
y = y + ActiveCell.Offset(, datacol)
ActiveCell.Offset(, destcol) = y
ActiveCell.Offset(1).Activate
Wend
End Sub

Sub RetainSum(KeyCol As String, datacol As Integer, destcol As Integer) 'to make percent calc easy
rmax = ActiveSheet.UsedRange.Rows.Count
rmin = 1
Cells(rmax, KeyCol).Activate
While ActiveCell.Row > rmin
x = 0
constx = ActiveCell.Offset(, datacol)
While ActiveCell = ActiveCell.Offset(-1)
If ActiveCell = ActiveCell.Offset(-1) Then
ActiveCell.Offset(, destcol) = constx
x = x + 1
End If
ActiveCell.Offset(-1).Activate
Wend
ActiveCell.Offset(, destcol) = constx
ActiveCell.Offset(-1).Activate
Wend
End Sub

Sub RunBoth()
SumByGroup "a2", 1, 2
RetainSum "a", 2, 3
End Sub